Commit | Line | Data |
---|---|---|
a7821be5 | 1 | package Moose::Meta::Method::Accessor::Native::Array::set; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
8b9641b8 | 6 | use Moose::Role; |
7 | ||
8 | with 'Moose::Meta::Method::Accessor::Native::Array::Writer' => { | |
9 | -excludes => [ | |
10 | qw( | |
11 | _minimum_arguments | |
12 | _maximum_arguments | |
13 | _inline_check_arguments | |
53a4677c | 14 | _inline_coerce_new_values |
8b9641b8 | 15 | _new_members |
a486d5ad | 16 | _inline_optimized_set_new_value |
7f5ec80d | 17 | _return_value |
8b9641b8 | 18 | ) |
19 | ] | |
20 | }; | |
a7821be5 | 21 | |
22 | sub _minimum_arguments { 2 } | |
23 | ||
24 | sub _maximum_arguments { 2 } | |
25 | ||
26 | sub _inline_check_arguments { | |
27 | my $self = shift; | |
28 | ||
29 | return $self->_inline_check_var_is_valid_index('$_[0]'); | |
30 | } | |
31 | ||
32 | sub _adds_members { 1 } | |
33 | ||
34 | sub _potential_value { | |
53a4677c | 35 | my $self = shift; |
36 | my ($slot_access) = @_; | |
a7821be5 | 37 | |
53a4677c | 38 | return '(do { ' |
39 | . 'my @potential = @{ (' . $slot_access . ') }; ' | |
40 | . '$potential[$_[0]] = $_[1]; ' | |
41 | . '\@potential; ' | |
42 | . '})'; | |
a7821be5 | 43 | } |
44 | ||
7bf5e58d | 45 | # We need to override this because while @_ can be written to, we cannot write |
46 | # directly to $_[1]. | |
53a4677c | 47 | sub _inline_coerce_new_values { |
7bf5e58d | 48 | my $self = shift; |
49 | ||
53a4677c | 50 | return unless $self->associated_attribute->should_coerce; |
7bf5e58d | 51 | |
53a4677c | 52 | return unless $self->_tc_member_type_can_coerce; |
7bf5e58d | 53 | |
53a4677c | 54 | return '@_ = ($_[0], $member_tc_obj->coerce($_[1]));'; |
7bf5e58d | 55 | }; |
56 | ||
44babf1f | 57 | sub _new_members { '$_[1]' } |
a7821be5 | 58 | |
a486d5ad | 59 | sub _inline_optimized_set_new_value { |
53a4677c | 60 | my $self = shift; |
61 | my ($inv, $new, $slot_access) = @_; | |
e32b7489 | 62 | |
a486d5ad | 63 | return $slot_access . '->[$_[0]] = $_[1];'; |
e32b7489 | 64 | } |
65 | ||
7f5ec80d | 66 | sub _return_value { |
53a4677c | 67 | my $self = shift; |
68 | my ($slot_access) = @_; | |
7f5ec80d | 69 | |
53a4677c | 70 | return $slot_access . '->[$_[0]]'; |
7f5ec80d | 71 | } |
72 | ||
8b9641b8 | 73 | no Moose::Role; |
74 | ||
a7821be5 | 75 | 1; |