1 package Moose::Meta::Method::Accessor::Native::Array::Writer;
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
10 use base 'Moose::Meta::Method::Accessor::Native::Array';
12 sub _generate_method {
17 my $slot_access = $self->_inline_get($inv);
20 $code .= "\n" . $self->_inline_pre_body(@_);
22 $code .= "\n" . 'my $self = shift;';
24 $code .= "\n" . $self->_inline_check_lazy($inv);
26 $code .= "\n" . $self->_inline_curried_arguments;
28 $code .= "\n" . $self->_inline_check_argument_count;
30 $code .= "\n" . $self->_inline_process_arguments;
32 $code .= "\n" . $self->_inline_check_arguments;
34 my $new_values = $self->_new_values($slot_access);
35 my $potential_value = $self->_potential_value($slot_access);
37 if ( $self->_value_needs_copy ) {
38 $code .= "\n" . "my \@potential = $potential_value;";
39 $potential_value = '@potential';
43 . $self->_inline_tc_code(
48 $code .= "\n" . $self->_inline_get_old_value_for_trigger($inv);
49 $code .= "\n" . $self->_capture_old_value($slot_access);
52 . $self->_inline_store(
54 $self->_value_needs_copy
55 ? '\\' . $potential_value
56 : '[' . $potential_value . ']'
59 $code .= "\n" . $self->_inline_post_body(@_);
60 $code .= "\n" . $self->_inline_trigger( $inv, $slot_access, '@old' );
62 $code .= "\n" . $self->_return_value( $inv, '@old' );
69 sub _inline_process_arguments {q{}}
71 sub _inline_check_arguments {q{}}
73 sub _new_values {'@_'}
75 sub _value_needs_copy {
78 return $self->_constraint_must_be_checked
79 && !$self->_check_new_members_only;
83 my ( $self, $new_value, $potential_value ) = @_;
85 return q{} unless $self->_constraint_must_be_checked;
87 if ( $self->_check_new_members_only ) {
88 return q{} unless $self->_adds_members;
90 return $self->_inline_check_member_constraint($new_value);
93 return $self->_inline_check_coercion( '\\' . $potential_value ) . "\n"
94 . $self->_inline_check_constraint( '\\' . $potential_value );
98 sub _constraint_must_be_checked {
101 my $attr = $self->associated_attribute;
103 return $attr->has_type_constraint
104 && ( $attr->type_constraint->name ne 'ArrayRef'
105 || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) );
108 sub _check_new_members_only {
111 my $attr = $self->associated_attribute;
113 my $tc = $attr->type_constraint;
115 # If we have a coercion, we could come up with an entirely new value after
116 # coercing, so we need to check everything,
117 return 0 if $attr->should_coerce && $tc->has_coercion;
119 # If the parent is ArrayRef, that means we can just check the new members
120 # of the collection, because we know that we will always be generating an
121 # ArrayRef. However, if this type has its own constraint, we don't know
122 # what the constraint checks, so we need to check the whole value, not
125 if $tc->parent->name eq 'ArrayRef'
126 && $tc->isa('Moose::Meta::TypeConstraint::Parameterized');
131 sub _inline_check_member_constraint {
132 my ( $self, $new_value ) = @_;
134 my $attr_name = $self->associated_attribute->name;
136 return '$member_tc->($_) || '
137 . $self->_inline_throw_error(
138 qq{"A new member value for '$attr_name' does not pass its type constraint because: "}
139 . ' . $member_tc->get_message($_)',
141 ) . " for $new_value;";
144 sub _inline_check_coercion {
145 my ( $self, $value ) = @_;
147 my $attr = $self->associated_attribute;
150 unless $attr->should_coerce && $attr->type_constraint->has_coercion;
152 # We want to break the aliasing in @_ in case the coercion tries to make a
153 # destructive change to an array member.
154 my $code = 'my @copy = @{ $value }';
155 return '@_ = @{ $attr->type_constraint->coerce(\@copy) };';
158 sub _inline_check_constraint {
161 return q{} unless $self->_constraint_must_be_checked;
163 return $self->SUPER::_inline_check_constraint( $_[0] );
166 sub _capture_old_value { return q{} }
167 sub _return_value { return q{} }
169 sub _eval_environment {
172 my $env = $self->SUPER::_eval_environment;
175 unless $self->_constraint_must_be_checked
176 and $self->_check_new_members_only;
179 = \( $self->associated_attribute->type_constraint->type_parameter
180 ->_compiled_type_constraint );