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.13';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use base qw(
  11     Moose::Meta::Method::Accessor::Native::String::Reader
  12     Moose::Meta::Method::Accessor::Native::String::Writer
  13 );
  14
  15 sub _generate_method {
  16     my $self = shift;
  17
  18     my $inv = '$self';
  19
  20     my $slot_access = $self->_inline_get($inv);
  21
  22     my $code = 'sub {';
  23
  24     $code .= "\n" . $self->_inline_pre_body(@_);
  25     $code .= "\n" . 'my $self = shift;';
  26
  27     $code .= "\n" . $self->_inline_curried_arguments;
  28
  29     $code .= "\n" . 'if ( @_ == 1 || @_ == 2 ) {';
  30
  31     $code .= $self->_reader_core( $inv, $slot_access, @_ );
  32
  33     $code .= "\n" . '} elsif ( @_ == 3 ) {';
  34
  35     $code .= $self->_writer_core( $inv, $slot_access, @_ );
  36
  37     $code .= "\n" . $self->_inline_post_body(@_);
  38
  39     $code .= "\n" . '} else {';
  40
  41     $code .= "\n" . $self->_inline_check_argument_count;
  42
  43     $code .= "\n" . '}';
  44     $code .= "\n" . '}';
  45
  46     return $code;
  47 }
  48
  49 sub _minimum_arguments {1}
  50 sub _maximum_arguments {3}
  51
  52 sub _inline_process_arguments {
  53     my ( $self, $inv, $slot_access ) = @_;
  54
  55     return
  56           'my $offset = shift;' . "\n"
  57         . "my \$length = \@_ ? shift : length $slot_access;" . "\n"
  58         . 'my $replacement = shift;';
  59 }
  60
  61 sub _inline_check_arguments {
  62     my ( $self, $for_writer ) = @_;
  63
  64     my $code
  65         = $self->_inline_throw_error(
  66         q{'The first argument passed to substr must be an integer'})
  67         . q{ if ref $offset || $offset !~ /^-?\\d+$/;} . "\n"
  68         . $self->_inline_throw_error(
  69         q{'The second argument passed to substr must be a positive integer'})
  70         . q{ if ref $length || $offset !~ /^-?\\d+$/;};
  71
  72     if ($for_writer) {
  73         $code
  74             .= "\n"
  75             . $self->_inline_throw_error(
  76             q{'The third argument passed to substr must be a string'})
  77             . q{ unless defined $replacement && ! ref $replacement;};
  78     }
  79
  80     return $code;
  81 }
  82
  83 sub _potential_value {
  84     my ( $self, $slot_access ) = @_;
  85
  86     return
  87         "( do { my \$potential = $slot_access; substr \$potential, \$offset, \$length, \$replacement; \$potential; } )";
  88 }
  89
  90 sub _inline_optimized_set_new_value {
  91     my ( $self, $inv, $new, $slot_access ) = @_;
  92
  93     return "substr $slot_access, \$offset, \$length, \$replacement;";
  94 }
  95
  96 sub _return_value {
  97     my ( $self, $slot_access, $for_writer ) = @_;
  98
  99     return q{} if $for_writer;
 100
 101     return "substr $slot_access, \$offset, \$length";
 102 }
 103
 104 1;