X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=2d6d7fab0185d4c8f9f07192259cafe11075b33f;hp=190d853def1ad7248f5754587a375cfebf19a028;hb=b06ce1f502945c13a52c503f1a651fe92c91c773;hpb=0126c27c413cb63f67e66e09b0fdfeb92117503a diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 190d853..2d6d7fa 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -2,7 +2,7 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings use overload - '""' => sub { shift->{name} }, # stringify to tc name + '""' => sub { $_[0]->name }, # stringify to tc name fallback => 1; use Carp qw(confess); @@ -31,11 +31,6 @@ sub new { $check = $args{constraint}; - if(blessed($check)){ - Carp::cluck("Constraint for $args{name} must be a CODE reference"); - $check = $check->{compiled_type_constraint}; - } - if(defined($check) && ref($check) ne 'CODE'){ confess("Constraint for $args{name} is not a CODE reference"); } @@ -86,13 +81,6 @@ sub create_child_type{ ); } -sub name { $_[0]->{name} } -sub parent { $_[0]->{parent} } -sub message { $_[0]->{message} } - -sub _compiled_type_constraint{ $_[0]->{compiled_type_constraint} } - -sub has_coercion{ exists $_[0]->{_compiled_type_coercion} } sub compile_type_constraint{ my($self) = @_; @@ -101,11 +89,11 @@ sub compile_type_constraint{ my @checks; for(my $parent = $self->parent; defined $parent; $parent = $parent->parent){ if($parent->{hand_optimized_type_constraint}){ - push @checks, $parent->{hand_optimized_type_constraint}; + unshift @checks, $parent->{hand_optimized_type_constraint}; last; # a hand optimized constraint must include all the parents } elsif($parent->{constraint}){ - push @checks, $parent->{constraint}; + unshift @checks, $parent->{constraint}; } } @@ -195,13 +183,11 @@ sub check { sub coerce { my $self = shift; - if(!$self->{_compiled_type_coercion}){ - confess("Cannot coerce without a type coercion ($self)"); - } return $_[0] if $self->_compiled_type_constraint->(@_); - return $self->{_compiled_type_coercion}->(@_); + my $coercion = $self->_compiled_type_coercion; + return $coercion ? $coercion->(@_) : $_[0]; } sub get_message { @@ -247,6 +233,10 @@ __END__ Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass +=head1 VERSION + +This document describes Mouse version 0.40_01 + =head1 DESCRIPTION For the most part, the only time you will ever encounter an