X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FAttribute.pm;h=a6fcee4a3cde5afeece534ca8c0c7d4c2eb79684;hb=c68b41108207ca7568f6f99a66cb6d202623a236;hp=9675ac35f016cac0952dad17c63c23b5b433e055;hpb=15ce26e85c2948fc21bf594780b8562c97faf27a;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 9675ac3..a6fcee4 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -73,23 +73,31 @@ sub generate_accessor { my $self = '$_[0]'; my $key = $attribute->inlined_name; - my $accessor = "sub {\n"; + my $accessor = + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + "sub {\n"; if ($attribute->_is_metadata eq 'rw') { - $accessor .= 'if (@_ >= 2) {' . "\n"; + $accessor .= + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'if (@_ >= 2) {' . "\n"; my $value = '$_[1]'; if ($constraint) { $accessor .= 'my $val = '; if ($should_coerce) { - $accessor .= 'Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{find_type_constraint}, $attribute->{type_constraint}, '.$value.');'; + $accessor .= + "\n". + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'Mouse::Util::TypeConstraints->typecast_constraints("'.$attribute->associated_class->name.'", $attribute->{find_type_constraint}, $attribute->{type_constraint}, '.$value.');'; } else { $accessor .= $value.';'; } - $accessor .= 'local $_ = $val;'; - $accessor .= ' - unless ($constraint->()) { - $attribute->verify_type_constraint_error($name, $_, $attribute->type_constraint); + $accessor .= + "\n". + '#line ' . __LINE__ . ' "' . __FILE__ . "\"\n" . + 'unless ($constraint->($val)) { + $attribute->verify_type_constraint_error($name, $val, $attribute->type_constraint); }' . "\n"; $value = '$val'; } @@ -105,7 +113,7 @@ sub generate_accessor { } if ($trigger) { - $accessor .= '$trigger->('.$self.', '.$value.', $attribute);' . "\n"; + $accessor .= '$trigger->('.$self.', '.$value.');' . "\n"; } $accessor .= "}\n"; @@ -114,13 +122,7 @@ sub generate_accessor { $accessor .= 'confess "Cannot assign a value to a read-only accessor" if scalar(@_) >= 2;' . "\n"; } - # XXX - edit by lestrrat 20090304: - # I couldn't quite tell why this happened, but I encountered a case - # where the default value was not set. In introspecting the resulting - # $accessor string, I realized that there was no default handling code. - # which led me to adding "|| $attribute->has_default" below. - # Tests passed, so I hope everything will be ok - if ($attribute->is_lazy || $attribute->has_default) { + if ($attribute->is_lazy) { $accessor .= $self.'->{'.$key.'} = '; $accessor .= $attribute->has_builder @@ -210,33 +212,20 @@ sub create { if exists $args{coerce}; if (exists $args{isa}) { - confess "Mouse does not yet support parameterized types (rt.cpan.org #39795)" - if $args{isa} =~ /\[.*\]/; + confess "Got isa => $args{isa}, but Mouse does not yet support parameterized types for containers other than ArrayRef and HashRef (rt.cpan.org #39795)" + if $args{isa} =~ /^([^\[]+)\[.+\]$/ && + $1 ne 'ArrayRef' && + $1 ne 'HashRef' && + $1 ne 'Maybe' + ; my $type_constraint = delete $args{isa}; - $type_constraint =~ s/\s//g; - my @type_constraints = split /\|/, $type_constraint; - - my $code; - my $optimized_constraints = Mouse::Util::TypeConstraints->optimized_constraints; - if (@type_constraints == 1) { - $code = $optimized_constraints->{$type_constraints[0]} || - sub { Scalar::Util::blessed($_) && $_->isa($type_constraints[0]) }; - $args{type_constraint} = $type_constraints[0]; - } else { - my @code_list = map { - my $type = $_; - $optimized_constraints->{$type} || - sub { Scalar::Util::blessed($_) && $_->isa($type) } - } @type_constraints; - $code = sub { - for my $code (@code_list) { - return 1 if $code->(); - } - return 0; - }; - $args{type_constraint} = \@type_constraints; - } + $type_constraint =~ s/\s+//g; + my $code = Mouse::Util::TypeConstraints::find_or_create_isa_type_constraint($type_constraint); + $args{type_constraint} = $type_constraint =~ /\|/ ? + [ split (/\|/, $type_constraint ) ] : + $type_constraint + ; $args{find_type_constraint} = $code; } @@ -344,7 +333,7 @@ sub verify_against_type_constraint { sub verify_type_constraint_error { my($self, $name, $value, $type) = @_; $type = ref($type) eq 'ARRAY' ? join '|', @{ $type } : $type; - my $display = defined($_) ? overload::StrVal($_) : 'undef'; + my $display = defined($value) ? overload::StrVal($value) : 'undef'; Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display"); }