"type" sugar for when you're not subtyping anything

[gitmo/Mouse.git] / lib / Mouse / Util / TypeConstraints.pm

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index 812ecd6..623bd83 100644 (file)
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -21,6 +21,7 @@ sub import {
     *{"$caller\::message"}     = \&_message;
     *{"$caller\::from"}        = \&_from;
     *{"$caller\::via"}         = \&_via;
+    *{"$caller\::type"}        = \&_type;
     *{"$caller\::subtype"}     = \&_subtype;
     *{"$caller\::coerce"}      = \&_coerce;
     *{"$caller\::class_type"}  = \&_class_type;
@@ -85,6 +86,16 @@ my $optimized_constraints_base;
     sub list_all_builtin_type_constraints { @SUBTYPE_KEYS }
 }
 
+sub _type {
+    my $pkg = caller(0);
+    my($name, %conf) = @_;
+    if (my $type = $SUBTYPE{$name}) {
+        Carp::croak "The type constraint '$name' has already been created, cannot be created again in $pkg";
+    };
+    my $stuff = $conf{where} || do { $SUBTYPE{delete $conf{as} || 'Any' } };
+    $SUBTYPE{$name} = $stuff;
+}
+
 sub _subtype {
     my $pkg = caller(0);
     my($name, %conf) = @_;