Better variable names

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

diff --git a/lib/Mouse/TypeRegistry.pm b/lib/Mouse/TypeRegistry.pm
index ecde30d..ff2350f 100644 (file)
--- a/lib/Mouse/TypeRegistry.pm
+++ b/lib/Mouse/TypeRegistry.pm
@@ -24,7 +24,7 @@ sub import {
     no strict 'refs';
     *{"$caller\::subtype"}     = \&_subtype;
     *{"$caller\::coerce"}      = \&_coerce;
-#    *{"$caller\::class_type"}  = \&_class_type;
+    *{"$caller\::class_type"}  = \&_class_type;
 #    *{"$caller\::role_type"}   = \&_role_type;
 }
 
@@ -52,6 +52,16 @@ sub _coerce {
     $COERCE->{$pkg}->{$name} = $conf;
 }
 
+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 typecast_constraints {
     my($class, $pkg, $type, $value) = @_;
     return $value unless defined $COERCE->{$pkg} && defined $COERCE->{$pkg}->{$type};