1 package Moose::Meta::Method::Accessor::Native::Array::Writer;
7 $VERSION = eval $VERSION;
8 our $AUTHORITY = 'cpan:STEVAN';
11 Moose::Meta::Method::Accessor::Native::Array
12 Moose::Meta::Method::Accessor::Native::Writer
15 sub _inline_process_arguments {q{}}
17 sub _inline_check_arguments {q{}}
21 sub _inline_copy_value {
22 my ( $self, $potential_ref ) = @_;
24 return q{} unless $self->_value_needs_copy;
26 my $code = "my \@potential = ${$potential_ref};";
28 ${$potential_ref} = '@potential';
33 sub _value_needs_copy {
36 return $self->_constraint_must_be_checked
37 && !$self->_check_new_members_only;
41 my ( $self, $new_value, $potential_value ) = @_;
43 return q{} unless $self->_constraint_must_be_checked;
45 if ( $self->_check_new_members_only ) {
46 return q{} unless $self->_adds_members;
48 return $self->_inline_check_member_constraint($new_value);
51 return $self->_inline_check_coercion( '\\' . $potential_value ) . "\n"
52 . $self->_inline_check_constraint( '\\' . $potential_value );
56 sub _constraint_must_be_checked {
59 my $attr = $self->associated_attribute;
61 return $attr->has_type_constraint
62 && ( $attr->type_constraint->name ne 'ArrayRef'
63 || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) );
66 sub _check_new_members_only {
69 my $attr = $self->associated_attribute;
71 my $tc = $attr->type_constraint;
73 # If we have a coercion, we could come up with an entirely new value after
74 # coercing, so we need to check everything,
75 return 0 if $attr->should_coerce && $tc->has_coercion;
77 # If the parent is ArrayRef, that means we can just check the new members
78 # of the collection, because we know that we will always be generating an
79 # ArrayRef. However, if this type has its own constraint, we don't know
80 # what the constraint checks, so we need to check the whole value, not
83 if $tc->parent->name eq 'ArrayRef'
84 && $tc->isa('Moose::Meta::TypeConstraint::Parameterized');
89 sub _inline_check_member_constraint {
90 my ( $self, $new_value ) = @_;
92 my $attr_name = $self->associated_attribute->name;
94 return '$member_tc->($_) || '
95 . $self->_inline_throw_error(
96 qq{"A new member value for '$attr_name' does not pass its type constraint because: "}
97 . ' . $member_tc->get_message($_)',
99 ) . " for $new_value;";
102 sub _inline_check_coercion {
103 my ( $self, $value ) = @_;
105 my $attr = $self->associated_attribute;
108 unless $attr->should_coerce && $attr->type_constraint->has_coercion;
110 # We want to break the aliasing in @_ in case the coercion tries to make a
111 # destructive change to an array member.
112 my $code = 'my @copy = @{ $value }';
113 return '@_ = @{ $attr->type_constraint->coerce(\@copy) };';
116 sub _inline_check_constraint {
119 return q{} unless $self->_constraint_must_be_checked;
121 return $self->SUPER::_inline_check_constraint( $_[0] );
124 sub _capture_old_value { return q{} }
126 sub _inline_set_new_value {
127 my ( $self, $inv, $new ) = @_;
129 return $self->SUPER::_inline_store(
131 $self->_value_needs_copy ? '\\' . $new : '[' . $new . ']'
135 sub _return_value { return q{} }
137 sub _eval_environment {
140 my $env = $self->SUPER::_eval_environment;
143 unless $self->_constraint_must_be_checked
144 and $self->_check_new_members_only;
147 = \( $self->associated_attribute->type_constraint->type_parameter
148 ->_compiled_type_constraint );