4b02f4c2aedcbdcd54d45c4f94b005222885a5eb
[gitmo/Moose.git] / lib / Moose / Meta / Method / Accessor / Native / Array / set.pm
1 package Moose::Meta::Method::Accessor::Native::Array::set;
2
3 use strict;
4 use warnings;
5
6 our $VERSION = '1.19';
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             _inline_check_arguments
18             _inline_coerce_new_values
19             _new_members
20             _optimized_set_new_value
21             _return_value
22             )
23     ]
24 };
25
26 sub _minimum_arguments { 2 }
27
28 sub _maximum_arguments { 2 }
29
30 sub _inline_check_arguments {
31     my $self = shift;
32
33     return $self->_inline_check_var_is_valid_index('$_[0]');
34 }
35
36 sub _adds_members { 1 }
37
38 sub _potential_value {
39     my $self = shift;
40     my ($slot_access) = @_;
41
42     return '(do { '
43              . 'my @potential = @{ (' . $slot_access . ') }; '
44              . '$potential[$_[0]] = $_[1]; '
45              . '\@potential; '
46          . '})';
47 }
48
49 # We need to override this because while @_ can be written to, we cannot write
50 # directly to $_[1].
51 sub _inline_coerce_new_values {
52     my $self = shift;
53
54     return unless $self->associated_attribute->should_coerce;
55
56     return unless $self->_tc_member_type_can_coerce;
57
58     return '@_ = ($_[0], $member_tc_obj->coerce($_[1]));';
59 };
60
61 sub _new_members { '$_[1]' }
62
63 sub _optimized_set_new_value {
64     my $self = shift;
65     my ($inv, $new, $slot_access) = @_;
66
67     return $slot_access . '->[$_[0]] = $_[1]';
68 }
69
70 sub _return_value {
71     my $self = shift;
72     my ($slot_access) = @_;
73
74     return $slot_access . '->[$_[0]]';
75 }
76
77 no Moose::Role;
78
79 1;