X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=lib%2FMouse%2FTypeRegistry.pm;h=15d3479f0525208c7143ee28f681b904634cf0b5;hp=ff2350f7ae405e1e130a1b047ac1d97fb99caa52;hb=47f36c052bd0722ea67a4fbc18aca51234a1f5bc;hpb=b6ffa107ada7a537575481d277818e207ed219fb

diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm
index ff2350f..15d3479 100644
--- 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};