lib/Moose/Meta/Method/Accessor/Native/Array/splice.pm

   1 package Moose::Meta::Method::Accessor::Native::Array::splice;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Role;
   7
   8 with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
   9     -excludes => [
  10         qw(
  11             _minimum_arguments
  12             _inline_process_arguments
  13             _inline_check_arguments
  14             _inline_optimized_set_new_value
  15             _return_value
  16             )
  17     ]
  18 };
  19
  20 sub _minimum_arguments { 1 }
  21
  22 sub _adds_members { 1 }
  23
  24 sub _inline_process_arguments {
  25     return (
  26         'my $idx = shift;',
  27         'my $len = @_ ? shift : undef;',
  28     );
  29 }
  30
  31 sub _inline_check_arguments {
  32     my $self = shift;
  33
  34     return (
  35         $self->_inline_check_var_is_valid_index('$idx'),
  36         'if (defined($len) && $len !~ /^-?\d+$/) {',
  37             $self->_inline_throw_error(
  38                 '"The length argument passed to splice must be an integer"',
  39             ) . ';',
  40         '}',
  41     );
  42 }
  43
  44 sub _potential_value {
  45     my $self = shift;
  46     my ($slot_access) = @_;
  47
  48     return '(do { '
  49              . 'my @potential = @{ (' . $slot_access . ') }; '
  50              . '@return = defined $len '
  51                  . '? (splice @potential, $idx, $len, @_) '
  52                  . ': (splice @potential, $idx); '
  53                  . '\@potential;'
  54          . '})';
  55 }
  56
  57 sub _inline_optimized_set_new_value {
  58     my $self = shift;
  59     my ($inv, $new, $slot_access) = @_;
  60
  61     return (
  62         '@return = defined $len',
  63             '? (splice @{ (' . $slot_access . ') }, $idx, $len, @_)',
  64             ': (splice @{ (' . $slot_access . ') }, $idx);',
  65     );
  66 }
  67
  68 sub _return_value {
  69     my $self = shift;
  70     my ($slot_access) = @_;
  71
  72     return 'wantarray ? @return : $return[-1]';
  73 }
  74
  75 no Moose::Role;
  76
  77 1;