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

   1 package Moose::Meta::Method::Accessor::Native::Array::insert;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.17';
   7 $VERSION = eval $VERSION;
   8 our $AUTHORITY = 'cpan:STEVAN';
   9
  10 use Moose::Role;
  11
  12 with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => {
  13     -excludes => [
  14         qw(
  15             _minimum_arguments
  16             _maximum_arguments
  17             _new_members
  18             _inline_optimized_set_new_value
  19             _return_value
  20             )
  21     ]
  22 };
  23
  24 sub _minimum_arguments { 2 }
  25
  26 sub _maximum_arguments { 2 }
  27
  28 sub _adds_members { 1 }
  29
  30 sub _potential_value {
  31     my ( $self, $slot_access ) = @_;
  32
  33     return
  34         "( do { my \@potential = \@{ ($slot_access) }; splice \@potential, \$_[0], 0, \$_[1]; \\\@potential } )";
  35 }
  36
  37 # We need to override this because while @_ can be written to, we cannot write
  38 # directly to $_[1].
  39 around _inline_coerce_new_values => sub {
  40     shift;
  41     my $self = shift;
  42
  43     return q{} unless $self->associated_attribute->should_coerce;
  44
  45     return q{} unless $self->_tc_member_type_can_coerce;
  46
  47     return '@_ = ( $_[0], $member_tc_obj->coerce( $_[1] ) );';
  48 };
  49
  50 sub _new_members { '$_[1]' }
  51
  52 sub _inline_optimized_set_new_value {
  53     my ( $self, $inv, $new, $slot_access ) = @_;
  54
  55     return "splice \@{ ($slot_access) }, \$_[0], 0, \$_[1];";
  56 }
  57
  58 sub _return_value {
  59     my ( $self, $slot_access ) = @_;
  60
  61     return "return ${slot_access}->[ \$_[0] ];";
  62 }
  63
  64 no Moose::Role;
  65
  66 1;