Add some whitespace
[gitmo/Moose.git] / lib / Moose / Meta / Method / Accessor / Native / Array / accessor.pm
CommitLineData
a7821be5 1package Moose::Meta::Method::Accessor::Native::Array::accessor;
2
3use strict;
4use warnings;
5
6our $VERSION = '1.13';
7$VERSION = eval $VERSION;
8our $AUTHORITY = 'cpan:STEVAN';
9
10use base qw(
11 Moose::Meta::Method::Accessor::Native::Array::get
12 Moose::Meta::Method::Accessor::Native::Array::set
13);
14
15sub _generate_method {
16 my $self = shift;
17
18 my $inv = '$self';
19
20 my $code = 'sub {';
21 $code .= "\n" . $self->_inline_pre_body(@_);
22
23 $code .= "\n" . 'my $self = shift;';
24
25 $code .= "\n" . $self->_inline_curried_arguments;
26
27 $code .= "\n" . $self->_inline_check_lazy($inv);
28
29 my $slot_access = $self->_inline_get($inv);
30
31 # get
32 $code .= "\n" . 'if ( @_ == 1 ) {';
33
34 $code .= "\n" . $self->_inline_check_var_is_valid_index('$_[0]');
35
36 $code .= "\n" . 'return ' . $self->_return_value($slot_access) . ';';
37
38 # set
39 $code .= "\n" . '} else {';
40
41 $code .= "\n" . $self->_inline_check_argument_count;
05c05448 42
a7821be5 43 $code
44 .= "\n"
45 . $self
46 ->Moose::Meta::Method::Accessor::Native::Array::set::_inline_check_arguments;
47
48 my $new_values = $self->_new_values($slot_access);
49 my $potential_value = $self->_potential_value($slot_access);
50
51 $code .= "\n"
52 . $self->_inline_tc_code(
53 $new_values,
54 $potential_value
55 );
56
57 $code .= "\n" . $self->_inline_get_old_value_for_trigger($inv);
58 $code .= "\n" . $self->_capture_old_value($slot_access);
59
60 $code
61 .= "\n" . $self->_inline_store( $inv, '[' . $potential_value . ']' );
62
63 $code .= "\n" . $self->_inline_post_body(@_);
64 $code .= "\n" . $self->_inline_trigger( $inv, $slot_access, '@old' );
65
66 $code .= "\n}";
67 $code .= "\n}";
68
69 return $code;
70}
71
72# If we get one argument we won't check the argument count
73sub _minimum_arguments {2}
74sub _maximum_arguments {2}
75
76sub _adds_members {1}
77
78sub _potential_value {
79 my ( $self, $slot_access ) = @_;
80
81 return
82 "( do { my \@potential = \@{ $slot_access }; \$potential[ \$_[0] ] = \$_[1]; \@potential } )";
83}
84
85sub _new_values {'$_[1]'}
86
87sub _eval_environment {
88 my $self = shift;
89
90 my $env = $self->SUPER::_eval_environment;
91
92 return $env
93 unless $self->_constraint_must_be_checked
94 and $self->_check_new_members_only;
95
96 $env->{'$member_tc'}
97 = \( $self->associated_attribute->type_constraint->type_parameter
98 ->_compiled_type_constraint );
99
100 return $env;
101}
102
1031;