added role_type on Mouse::TypeRegistry

[gitmo/Mouse.git] / lib / Mouse / TypeRegistry.pm

diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm
index 32bd435..15d3479 100644 (file)
--- a/lib/Mouse/TypeRegistry.pm
+++ b/lib/Mouse/TypeRegistry.pm
@@ -24,8 +24,8 @@ sub import {
     no strict 'refs';
     *{"$caller\::subtype"}     = \&_subtype;
     *{"$caller\::coerce"}      = \&_coerce;
-#    *{"$caller\::class_type"}  = \&_class_type;
-#    *{"$caller\::role_type"}   = \&_role_type;
+    *{"$caller\::class_type"}  = \&_class_type;
+    *{"$caller\::role_type"}   = \&_role_type;
 }
 
 sub _import {
@@ -52,7 +52,27 @@ sub _coerce {
     $COERCE->{$pkg}->{$name} = $conf;
 }
 
-use Data::Dumper;
+sub _class_type {
+    my $pkg = caller(0);
+    $SUBTYPE->{$pkg} ||= +{};
+    my($name, $conf) = @_;
+    my $class = $conf->{class};
+    $SUBTYPE->{$pkg}->{$name} = sub {
+        defined $_ && ref($_) eq $class;
+    };
+}
+
+sub _role_type {
+    my $pkg = caller(0);
+    $SUBTYPE->{$pkg} ||= +{};
+    my($name, $conf) = @_;
+    my $role = $conf->{role};
+    $SUBTYPE->{$pkg}->{$name} = sub {
+        return unless defined $_ && ref($_) && $_->isa('Mouse::Object');
+        $_->meta->does_role($role);
+    };
+}
+
 sub typecast_constraints {
     my($class, $pkg, $type, $value) = @_;
     return $value unless defined $COERCE->{$pkg} && defined $COERCE->{$pkg}->{$type};
@@ -66,8 +86,6 @@ sub typecast_constraints {
         }
     }
 
-
-warn Dumper($COERCE);
     return $value;
 }