1 package Moose::Meta::Method::Accessor::Native::String::substr;
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
12 with 'Moose::Meta::Method::Accessor::Native::Reader' => {
17 _inline_process_arguments
18 _inline_check_arguments
23 'Moose::Meta::Method::Accessor::Native::Writer' => {
29 _inline_process_arguments
30 _inline_check_arguments
31 _inline_optimized_set_new_value
37 sub _generate_method {
42 my $slot_access = $self->_inline_get($inv);
46 $code .= "\n" . $self->_inline_pre_body(@_);
47 $code .= "\n" . 'my $self = shift;';
49 $code .= "\n" . $self->_inline_curried_arguments;
51 $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {';
53 $code .= $self->_reader_core( $inv, $slot_access );
55 $code .= "\n" . '} elsif ( @_ == 3 ) {';
57 $code .= $self->_writer_core( $inv, $slot_access );
59 $code .= "\n" . $self->_inline_post_body(@_);
61 $code .= "\n" . '} else {';
63 $code .= "\n" . $self->_inline_check_argument_count;
71 sub _minimum_arguments {1}
72 sub _maximum_arguments {3}
74 sub _inline_process_arguments {
75 my ( $self, $inv, $slot_access ) = @_;
78 'my $offset = shift;' . "\n"
79 . "my \$length = \@_ ? shift : length $slot_access;" . "\n"
80 . 'my $replacement = shift;';
83 sub _inline_check_arguments {
84 my ( $self, $for_writer ) = @_;
87 = $self->_inline_throw_error(
88 q{'The first argument passed to substr must be an integer'})
89 . q{ if ref $offset || $offset !~ /^-?\\d+$/;} . "\n"
90 . $self->_inline_throw_error(
91 q{'The second argument passed to substr must be a positive integer'})
92 . q{ if ref $length || $offset !~ /^-?\\d+$/;};
97 . $self->_inline_throw_error(
98 q{'The third argument passed to substr must be a string'})
99 . q{ unless defined $replacement && ! ref $replacement;};
105 sub _potential_value {
106 my ( $self, $slot_access ) = @_;
109 "( do { my \$potential = $slot_access; substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
112 sub _inline_optimized_set_new_value {
113 my ( $self, $inv, $new, $slot_access ) = @_;
115 return "substr $slot_access, \$offset, \$length, \$replacement";
119 my ( $self, $slot_access, $for_writer ) = @_;
121 return q{} if $for_writer;
123 return "substr $slot_access, \$offset, \$length";