lib/Moose/Meta/Method/Accessor/Native/String/substr.pm

   1 package Moose::Meta::Method::Accessor::Native::String::substr;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.14';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use Moose::Role;
  11
  12 with 'Moose::Meta::Method::Accessor::Native::Reader' => {
  13     -excludes => [
  14         qw( _generate_method
  15             _minimum_arguments
  16             _maximum_arguments
  17             _inline_process_arguments
  18             _inline_check_arguments
  19             _return_value
  20             )
  21     ]
  22     },
  23     'Moose::Meta::Method::Accessor::Native::Writer' => {
  24     -excludes => [
  25         qw(
  26             _generate_method
  27             _minimum_arguments
  28             _maximum_arguments
  29             _inline_process_arguments
  30             _inline_check_arguments
  31             _inline_optimized_set_new_value
  32             _return_value
  33             )
  34     ]
  35     };
  36
  37 sub _generate_method {
  38     my $self = shift;
  39
  40     my $inv = '$self';
  41
  42     my $slot_access = $self->_inline_get($inv);
  43
  44     my $code = 'sub {';
  45
  46     $code .= "\n" . $self->_inline_pre_body(@_);
  47     $code .= "\n" . 'my $self = shift;';
  48
  49     $code .= "\n" . $self->_inline_curried_arguments;
  50
  51     $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {';
  52
  53     $code .= $self->_reader_core( $inv, $slot_access );
  54
  55     $code .= "\n" . '} elsif ( @_ == 3 ) {';
  56
  57     $code .= $self->_writer_core( $inv, $slot_access );
  58
  59     $code .= "\n" . $self->_inline_post_body(@_);
  60
  61     $code .= "\n" . '} else {';
  62
  63     $code .= "\n" . $self->_inline_check_argument_count;
  64
  65     $code .= "\n" . '}';
  66     $code .= "\n" . '}';
  67
  68     return $code;
  69 }
  70
  71 sub _minimum_arguments {1}
  72 sub _maximum_arguments {3}
  73
  74 sub _inline_process_arguments {
  75     my ( $self, $inv, $slot_access ) = @_;
  76
  77     return
  78           'my $offset = shift;' . "\n"
  79         . "my \$length = \@_ ? shift : length $slot_access;" . "\n"
  80         . 'my $replacement = shift;';
  81 }
  82
  83 sub _inline_check_arguments {
  84     my ( $self, $for_writer ) = @_;
  85
  86     my $code
  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+$/;};
  93
  94     if ($for_writer) {
  95         $code
  96             .= "\n"
  97             . $self->_inline_throw_error(
  98             q{'The third argument passed to substr must be a string'})
  99             . q{ unless defined $replacement && ! ref $replacement;};
 100     }
 101
 102     return $code;
 103 }
 104
 105 sub _potential_value {
 106     my ( $self, $slot_access ) = @_;
 107
 108     return
 109         "( do { my \$potential = $slot_access; substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
 110 }
 111
 112 sub _inline_optimized_set_new_value {
 113     my ( $self, $inv, $new, $slot_access ) = @_;
 114
 115     return "substr $slot_access, \$offset, \$length, \$replacement";
 116 }
 117
 118 sub _return_value {
 119     my ( $self, $slot_access, $for_writer ) = @_;
 120
 121     return q{} if $for_writer;
 122
 123     return "substr $slot_access, \$offset, \$length";
 124 }
 125
 126 no Moose::Role;
 127
 128 1;