X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=30edadd01dcd2f9ed37dd9b296d7725d98d0805f;hb=b880de945fcf59e9811132613b5bcbca8a6d8696;hp=9dd67dbc134f65e1a67f6ef684fc457327d81b74;hpb=9b9e4b6566015d6d6e2aa6c745644174efa74623;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm index 9dd67db..30edadd 100644 --- a/lib/Mouse/Meta/TypeConstraint.pm +++ b/lib/Mouse/Meta/TypeConstraint.pm @@ -2,11 +2,20 @@ package Mouse::Meta::TypeConstraint; use Mouse::Util qw(:meta); # enables strict and warnings use overload - '""' => sub { shift->{name} }, # stringify to tc name + 'bool' => sub { 1 }, # always true + + '""' => sub { $_[0]->name }, # stringify to tc name + + '|' => sub { # or-combination + require Mouse::Util::TypeConstraints; + return Mouse::Util::TypeConstraints::find_or_parse_type_constraint( + "$_[0] | $_[1]", + ); + }, + fallback => 1; -use Carp qw(confess); -use Scalar::Util qw(blessed reftype); +use Carp (); my $null_check = sub { 1 }; @@ -31,13 +40,8 @@ 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"); + Carp::confess("Constraint for $args{name} is not a CODE reference"); } $args{package_defined_in} ||= caller; @@ -86,13 +90,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 +98,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}; } } @@ -159,18 +156,18 @@ sub _add_type_coercions{ my $action = $_[++$i]; if(exists $has{$from}){ - confess("A coercion action already exists for '$from'"); + Carp::confess("A coercion action already exists for '$from'"); } my $type = Mouse::Util::TypeConstraints::find_or_parse_type_constraint($from) - or confess("Could not find the type constraint ($from) to coerce from"); + or Carp::confess("Could not find the type constraint ($from) to coerce from"); push @{$coercions}, [ $type => $action ]; } # compile if(exists $self->{type_constraints}){ # union type - confess("Cannot add additional type coercions to Union types"); + Carp::confess("Cannot add additional type coercions to Union types"); } else{ $self->{_compiled_type_coercion} = sub { @@ -195,13 +192,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 { @@ -220,7 +215,7 @@ sub is_a_type_of{ my($self, $other) = @_; # ->is_a_type_of('__ANON__') is always false - return 0 if !blessed($other) && $other eq '__ANON__'; + return 0 if !ref($other) && $other eq '__ANON__'; (my $other_name = $other) =~ s/\s+//g; @@ -249,7 +244,7 @@ Mouse::Meta::TypeConstraint - The Mouse Type Constraint metaclass =head1 VERSION -This document describes Mouse version 0.39 +This document describes Mouse version 0.40_02 =head1 DESCRIPTION