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 ff2350f..15d3479 100644 (file)
--- a/lib/Mouse/TypeRegistry.pm
+++ b/lib/Mouse/TypeRegistry.pm
@@ -25,7 +25,7 @@ sub import {
     *{"$caller\::subtype"}     = \&_subtype;
     *{"$caller\::coerce"}      = \&_coerce;
     *{"$caller\::class_type"}  = \&_class_type;
-#    *{"$caller\::role_type"}   = \&_role_type;
+    *{"$caller\::role_type"}   = \&_role_type;
 }
 
 sub _import {
@@ -62,6 +62,17 @@ sub _class_type {
     };
 }
 
+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};