X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=14ba4bdb825ca311557e430e6647c637c58ba2be;hb=d05076770637c1e30860f931054a720f3883b0f2;hp=85b5698c5b369e0fd430cb927bf590d885cc4f3c;hpb=bc69ee88207ce5c53f5c02dbd44cfabfbe6bae70;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 85b5698..14ba4bd 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -9,7 +9,8 @@ use Mouse::Exporter; Mouse::Exporter->setup_import_methods( as_is => [qw( - as where message from via + as where message optimize_as + from via type subtype coerce class_type role_type enum find_type_constraint )], @@ -19,15 +20,10 @@ Mouse::Exporter->setup_import_methods( my %TYPE; -sub as ($) { - return(as => $_[0]); -} -sub where (&) { - return(where => $_[0]) -} -sub message (&) { - return(message => $_[0]) -} +sub as ($) { (as => $_[0]) } +sub where (&) { (where => $_[0]) } +sub message (&) { (message => $_[0]) } +sub optimize_as (&) { (optimize_as => $_[0]) } sub from { @_ } sub via (&) { $_[0] } @@ -111,6 +107,14 @@ sub _create_type{ } $args{name} = $name; + my $parent; + if($mode eq 'subtype'){ + $parent = delete $args{as}; + if(!$parent){ + $parent = delete $args{name}; + $name = '__ANON__'; + } + } my $package_defined_in = $args{package_defined_in} ||= caller(1); @@ -120,14 +124,11 @@ sub _create_type{ . "$existing->{package_defined_in} and cannot be created again in $package_defined_in"); } - $args{constraint} = delete($args{where}) if exists $args{where}; + $args{constraint} = delete $args{where} if exists $args{where}; $args{optimized} = delete $args{optimized_as} if exists $args{optimized_as}; my $constraint; if($mode eq 'subtype'){ - my $parent = delete($args{as}) - or confess('A subtype cannot consist solely of a name, it must have a parent'); - $constraint = find_or_create_isa_type_constraint($parent)->create_child_type(%args); } else{ @@ -303,9 +304,9 @@ sub _find_or_create_parameterized_type{ } } sub _find_or_create_union_type{ - my @types = map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_; + my @types = sort{ $a cmp $b } map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_; - my $name = join '|', map{ $_->name } @types; + my $name = join '|', @types; $TYPE{$name} ||= do{ return Mouse::Meta::TypeConstraint->new( @@ -398,12 +399,7 @@ sub find_or_parse_type_constraint { } sub find_or_create_does_type_constraint{ - my $type = find_or_parse_type_constriant(@_) || role_type(@_); - - if($type->{type} && $type->{type} ne 'Role'){ - Carp::cluck("$type is not a role type"); - } - return $type; + return find_or_parse_type_constraint(@_) || role_type(@_); } sub find_or_create_isa_type_constraint {