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
  10 sub _minimum_arguments { 1 }
  11
  12 sub _adds_members { 1 }
  13
  14 sub _inline_process_arguments {
  15     return (
  16         'my $idx = shift;',
  17         'my $len = @_ ? shift : undef;',
  18     );
  19 }
  20
  21 sub _inline_check_arguments {
  22     my $self = shift;
  23
  24     return (
  25         $self->_inline_check_var_is_valid_index('$idx'),
  26         'if (defined($len) && $len !~ /^-?\d+$/) {',
  27             $self->_inline_throw_error(
  28                 '"The length argument passed to splice must be an integer"',
  29             ) . ';',
  30         '}',
  31     );
  32 }
  33
  34 sub _potential_value {
  35     my $self = shift;
  36     my ($slot_access) = @_;
  37
  38     return '(do { '
  39              . 'my @potential = @{ (' . $slot_access . ') }; '
  40              . '@return = defined $len '
  41                  . '? (splice @potential, $idx, $len, @_) '
  42                  . ': (splice @potential, $idx); '
  43                  . '\@potential;'
  44          . '})';
  45 }
  46
  47 sub _inline_optimized_set_new_value {
  48     my $self = shift;
  49     my ($inv, $new, $slot_access) = @_;
  50
  51     return (
  52         '@return = defined $len',
  53             '? (splice @{ (' . $slot_access . ') }, $idx, $len, @_)',
  54             ': (splice @{ (' . $slot_access . ') }, $idx);',
  55     );
  56 }
  57
  58 sub _return_value {
  59     my $self = shift;
  60     my ($slot_access) = @_;
  61
  62     return 'wantarray ? @return : $return[-1]';
  63 }
  64
  65 no Moose::Role;
  66
  67 1;