1 package Moose::Meta::Method::Accessor::Native::String::substr;
9 $VERSION = eval $VERSION;
10 our $AUTHORITY = 'cpan:STEVAN';
14 with 'Moose::Meta::Method::Accessor::Native::Reader' => {
19 _inline_process_arguments
20 _inline_check_arguments
25 'Moose::Meta::Method::Accessor::Native::Writer' => {
31 _inline_process_arguments
32 _inline_check_arguments
33 _inline_optimized_set_new_value
39 sub _generate_method {
44 my $slot_access = $self->_inline_get($inv);
48 $code .= "\n" . $self->_inline_pre_body(@_);
49 $code .= "\n" . 'my $self = shift;';
51 $code .= "\n" . $self->_inline_curried_arguments;
53 $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {';
55 $code .= $self->_reader_core( $inv, $slot_access );
57 $code .= "\n" . '} elsif ( @_ == 3 ) {';
59 $code .= $self->_writer_core( $inv, $slot_access );
61 $code .= "\n" . $self->_inline_post_body(@_);
63 $code .= "\n" . '} else {';
65 $code .= "\n" . $self->_inline_check_argument_count;
73 sub _minimum_arguments {1}
74 sub _maximum_arguments {3}
76 sub _inline_process_arguments {
77 my ( $self, $inv, $slot_access ) = @_;
80 'my $offset = shift;' . "\n"
81 . "my \$length = \@_ ? shift : length $slot_access;" . "\n"
82 . 'my $replacement = shift;';
85 sub _inline_check_arguments {
86 my ( $self, $for_writer ) = @_;
89 = $self->_inline_throw_error(
90 q{'The first argument passed to substr must be an integer'})
91 . q{ unless $offset =~ /^-?\\d+$/;} . "\n"
92 . $self->_inline_throw_error(
93 q{'The second argument passed to substr must be an integer'})
94 . q{ unless $length =~ /^-?\\d+$/;};
99 . $self->_inline_throw_error(
100 q{'The third argument passed to substr must be a string'})
101 . q{ unless Moose::Util::_STRINGLIKE0($replacement);};
107 sub _potential_value {
108 my ( $self, $slot_access ) = @_;
111 "( do { my \$potential = $slot_access; \@return = substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
114 sub _inline_optimized_set_new_value {
115 my ( $self, $inv, $new, $slot_access ) = @_;
117 return "\@return = substr $slot_access, \$offset, \$length, \$replacement";
121 my ( $self, $slot_access, $for_writer ) = @_;
123 return '$return[0]' if $for_writer;
125 return "substr $slot_access, \$offset, \$length";