Remove extra newline
[gitmo/Moose.git] / lib / Moose / Meta / Method / Accessor / Native / Collection.pm
CommitLineData
44babf1f 1package Moose::Meta::Method::Accessor::Native::Collection;
2
3use strict;
4use warnings;
5
10bd99ec 6our $VERSION = '1.14';
44babf1f 7$VERSION = eval $VERSION;
8our $AUTHORITY = 'cpan:STEVAN';
9
10sub _value_needs_copy {
11 shift;
12 my $self = shift;
13
14 return $self->_constraint_must_be_checked
15 && !$self->_check_new_members_only;
16}
17
18sub _inline_tc_code {
19 shift;
20 my ( $self, $potential_value ) = @_;
21
22 return q{} unless $self->_constraint_must_be_checked;
23
24 if ( $self->_check_new_members_only ) {
25 return q{} unless $self->_adds_members;
26
27 return $self->_inline_check_member_constraint( $self->_new_members );
28 }
29 else {
30 return $self->_inline_check_coercion($potential_value) . "\n"
31 . $self->_inline_check_constraint($potential_value);
32 }
33}
34
35sub _check_new_members_only {
36 my $self = shift;
37
38 my $attr = $self->associated_attribute;
39
40 my $tc = $attr->type_constraint;
41
42 # If we have a coercion, we could come up with an entirely new value after
43 # coercing, so we need to check everything,
44 return 0 if $attr->should_coerce && $tc->has_coercion;
45
46 # If the parent is our root type (ArrayRef, HashRef, etc), that means we
47 # can just check the new members of the collection, because we know that
48 # we will always be generating an appropriate collection type.
49 #
50 # However, if this type has its own constraint (it's Parameteriz_able_,
51 # not Paramet_erized_), we don't know what is being checked by the
52 # constraint, so we need to check the whole value, not just the members.
53 return 1
54 if $self->_is_root_type( $tc->parent )
55 && $tc->isa('Moose::Meta::TypeConstraint::Parameterized');
56
57 return 0;
58}
59
60sub _inline_check_member_constraint {
61 my ( $self, $new_value ) = @_;
62
63 my $attr_name = $self->associated_attribute->name;
64
65 return '$member_tc->($_) || '
66 . $self->_inline_throw_error(
67 qq{"A new member value for '$attr_name' does not pass its type constraint because: "}
68 . ' . $member_tc->get_message($_)',
69 "data => \$_"
70 ) . " for $new_value;";
71}
72
73sub _inline_check_constraint {
74 my $orig = shift;
75 my $self = shift;
76
77 return q{} unless $self->_constraint_must_be_checked;
78
79 return $self->$orig( $_[0] );
80}
81
82sub _inline_get_old_value_for_trigger {
83 shift;
84 my ( $self, $instance ) = @_;
85
86 my $attr = $self->associated_attribute;
87 return '' unless $attr->has_trigger;
88
44babf1f 89 return
d67398ab 90 'my @old = '
91 . $self->_inline_has($instance) . q{ ? }
44babf1f 92 . $self->_inline_copy_old_value( $self->_inline_get($instance) )
d67398ab 93 . ": ();\n";
44babf1f 94}
95
96sub _eval_environment {
97 my $orig = shift;
98 my $self = shift;
99
100 my $env = $self->$orig(@_);
101
102 return $env
103 unless $self->_constraint_must_be_checked
104 && $self->_check_new_members_only;
105
106 $env->{'$member_tc'}
107 = \( $self->associated_attribute->type_constraint->type_parameter
108 ->_compiled_type_constraint );
109
110 return $env;
111}
112
113no Moose::Role;
114
1151;