1package Moose::Meta::Method::Accessor::Native::String::substr;
2our $VERSION = '2.2201';
3
4use strict;
5use warnings;
6
7use Moose::Util ();
8
9use Moose::Role;
10
11with 'Moose::Meta::Method::Accessor::Native::Reader',
12     'Moose::Meta::Method::Accessor::Native::Writer';
13
14sub _generate_method {
15    my $self = shift;
16
17    my $inv         = '$self';
18    my $slot_access = $self->_get_value($inv);
19
20    return (
21        'sub {',
22            'my ' . $inv . ' = shift;',
23            $self->_inline_curried_arguments,
24            'if (@_ == 1 || @_ == 2) {',
25                $self->_inline_reader_core($inv, $slot_access),
26            '}',
27            'elsif (@_ == 3) {',
28                $self->_inline_writer_core($inv, $slot_access),
29            '}',
30            'else {',
31                $self->_inline_check_argument_count,
32            '}',
33        '}',
34    );
35}
36
37sub _minimum_arguments { 1 }
38sub _maximum_arguments { 3 }
39
40sub _inline_process_arguments {
41    my $self = shift;
42    my ($inv, $slot_access) = @_;
43
44    return (
45        'my $offset = shift;',
46        'my $length = @_ ? shift : length ' . $slot_access . ';',
47        'my $replacement = shift;',
48    );
49}
50
51sub _inline_check_arguments {
52    my $self = shift;
53    my ($for_writer) = @_;
54
55    my @code = (
56        'if ($offset !~ /^-?\d+$/) {',
57            $self->_inline_throw_exception( InvalidArgumentToMethod =>
58                                            'argument                => $offset,'.
59                                            'ordinal                 => "first",'.
60                                            'type_of_argument        => "integer",'.
61                                            'method_name             => "substr",'.
62                                            'type                    => "Int"',
63            ) . ';',
64        '}',
65        'if ($length !~ /^-?\d+$/) {',
66            $self->_inline_throw_exception( InvalidArgumentToMethod =>
67                                            'argument                => $length,'.
68                                            'ordinal                 => "second",'.
69                                            'type_of_argument        => "integer",'.
70                                            'method_name             => "substr",'.
71                                            'type                    => "Int"',
72            ) . ';',
73        '}',
74    );
75
76    if ($for_writer) {
77        push @code, (
78            'if (!Moose::Util::_STRINGLIKE0($replacement)) {',
79                $self->_inline_throw_exception( InvalidArgumentToMethod =>
80                                                'argument                => $replacement,'.
81                                                'ordinal                 => "third",'.
82                                                'type_of_argument        => "string",'.
83                                                'method_name             => "substr",'.
84                                                'type                    => "Str"',
85                ) . ';',
86            '}',
87        );
88    }
89
90    return @code;
91}
92
93sub _potential_value {
94    my $self = shift;
95    my ($slot_access) = @_;
96
97    return '(do { '
98             . 'my $potential = ' . $slot_access . '; '
99             . '@return = substr $potential, $offset, $length, $replacement; '
100             . '$potential; '
101         . '})';
102}
103
104sub _inline_optimized_set_new_value {
105    my $self = shift;
106    my ($inv, $new, $slot_access) = @_;
107
108    return '@return = substr ' . $slot_access . ', '
109                           . '$offset, $length, $replacement;';
110}
111
112sub _return_value {
113    my $self = shift;
114    my ($slot_access, $for_writer) = @_;
115
116    return '$return[0]' if $for_writer;
117
118    return 'substr ' . $slot_access . ', $offset, $length';
119}
120
121no Moose::Role;
122
1231;
124