-#!/usr/bin/env perl
package Mouse::TypeRegistry;
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;
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 {
my $pkg = caller(0);
my($name, $conf) = @_;
my $class = $conf->{class};
+ Mouse::load_class($class);
_subtype(
- $name => where => sub {
- defined $_ && ref($_) eq $class;
- }
+ $name => where => sub { $_->isa($class) }
);
}