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=9582efda8949e299975dd4094c3967c0dd4584e6;hpb=98ab51333533a85f044f893160daaf525fb6da2c;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm index 9582efd..14ba4bd 100644 --- a/lib/Mouse/Util/TypeConstraints.pm +++ b/lib/Mouse/Util/TypeConstraints.pm @@ -1,32 +1,29 @@ package Mouse::Util::TypeConstraints; -use strict; -use warnings; - -use Exporter; +use Mouse::Util qw(does_role not_supported); # enables strict and warnings use Carp qw(confess); use Scalar::Util qw/blessed looks_like_number openhandle/; -use Mouse::Util qw(does_role not_supported); use Mouse::Meta::TypeConstraint; +use Mouse::Exporter; + +Mouse::Exporter->setup_import_methods( + as_is => [qw( + as where message optimize_as + from via + type subtype coerce class_type role_type enum + find_type_constraint + )], -our @ISA = qw(Exporter); -our @EXPORT = qw( - as where message from via type subtype coerce class_type role_type enum - find_type_constraint + _export_to_main => 1, ); 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] } @@ -110,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); @@ -119,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{ @@ -302,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( @@ -397,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 {