X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FTypeRegistry.pm;h=055c1ac629841bdaf489af2486f1c6026e0e914b;hb=2f665925359d9fba8a49baeccd7ad798f733221d;hp=4a97237fa38ecbc9278e2f703ffabb4da484ab43;hpb=b3b74cc602b1f2490396e407aa38970b5aa6921a;p=gitmo%2FMouse.git diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm index 4a97237..055c1ac 100644 --- a/lib/Mouse/TypeRegistry.pm +++ b/lib/Mouse/TypeRegistry.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Carp (); -use Mouse::Util qw/blessed looks_like_number openhandle/; +use Scalar::Util qw/blessed looks_like_number openhandle/; my %SUBTYPE; my %COERCE; @@ -92,10 +92,13 @@ sub _subtype { if (my $type = $SUBTYPE{$name}) { Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg"; }; - my $as = $conf{as}; - my $stuff = $conf{where} || $SUBTYPE{$as}; - - $SUBTYPE{$name} = $stuff; + my $stuff = $conf{where} || do { $SUBTYPE{delete $conf{as} || 'Any' } }; + my $as = $conf{as} || ''; + if ($as = $SUBTYPE{$as}) { + $SUBTYPE{$name} = sub { $as->($_) && $stuff->($_) }; + } else { + $SUBTYPE{$name} = $stuff; + } } sub _coerce { @@ -124,6 +127,7 @@ sub _class_type { my $pkg = caller(0); my($name, $conf) = @_; my $class = $conf->{class}; + Mouse::load_class($class); _subtype( $name => where => sub { defined $_ && ref($_) eq $class;