X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FUtil%2FTypeConstraints.pm;h=73ad008205a3b09d8cba81654b0ddf61ff6a083a;hb=983d58a5ea543a21c48cb04311883f1b36de1874;hp=b27d94620ebe0dd7cc87b8d157f2a5cccefd28dd;hpb=b0d52f035ebf10fd15a1ac8a8f0c6149e52af800;p=gitmo%2FMouse.git

diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index b27d946..73ad008 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -1,12 +1,12 @@
 package Mouse::Util::TypeConstraints;
 use Mouse::Util; # enables strict and warnings
 
-use Carp         ();
-use Scalar::Util ();
-
 use Mouse::Meta::TypeConstraint;
 use Mouse::Exporter;
 
+use Carp         ();
+use Scalar::Util ();
+
 Mouse::Exporter->setup_import_methods(
     as_is => [qw(
         as where message optimize_as
@@ -66,7 +66,6 @@ my @builtins = (
     RoleName   => 'ClassName', \&RoleName,
 );
 
-
 while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
     $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
         name      => $name,
@@ -75,14 +74,12 @@ while (my ($name, $parent, $code) = splice @builtins, 0, 3) {
     );
 }
 
-# make it parametarizable
-
+# parametarizable types
 $TYPE{Maybe}   {constraint_generator} = \&_parameterize_Maybe_for;
 $TYPE{ArrayRef}{constraint_generator} = \&_parameterize_ArrayRef_for;
 $TYPE{HashRef} {constraint_generator} = \&_parameterize_HashRef_for;
 
 # sugars
-
 sub as          ($) { (as          => $_[0]) } ## no critic
 sub where       (&) { (where       => $_[0]) } ## no critic
 sub message     (&) { (message     => $_[0]) } ## no critic
@@ -101,7 +98,6 @@ sub optimized_constraints { # DEPRECATED
 undef @builtins;        # free the allocated memory
 @builtins = keys %TYPE; # reuse it
 sub list_all_builtin_type_constraints { @builtins }
-
 sub list_all_type_constraints         { keys %TYPE }
 
 sub _define_type {
@@ -149,7 +145,7 @@ sub _define_type {
             }
         }
 
-        if($TYPE{$name}){
+        if(defined $TYPE{$name}){
             my $that = $TYPE{$name}->{package_defined_in} || __PACKAGE__;
             if($this ne $that) {
                 my $note = '';
@@ -187,11 +183,10 @@ sub subtype {
     return _define_type 1, @_;
 }
 
-sub coerce {
+sub coerce { # coerce $type, from $from, via { ... }, ...
     my $type_name = shift;
-
     my $type = find_type_constraint($type_name)
-        or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it.");
+        or Carp::croak("Cannot find type '$type_name', perhaps you forgot to load it");
 
     $type->_add_type_coercions(@_);
     return;
@@ -202,7 +197,7 @@ sub class_type {
     my $class = $options->{class} || $name;
 
     # ClassType
-    return _define_type 1, $name => (
+    return subtype $name => (
         as           => 'Object',
         optimized_as => Mouse::Util::generate_isa_predicate_for($class),
         class        => $class,
@@ -214,7 +209,7 @@ sub role_type {
     my $role = $options->{role} || $name;
 
     # RoleType
-    return _define_type 1, $name => (
+    return subtype $name => (
         as           => 'Object',
         optimized_as => sub {
             return Scalar::Util::blessed($_[0])
@@ -295,8 +290,9 @@ sub _find_or_create_parameterized_type{
 }
 
 sub _find_or_create_union_type{
-    return if grep{ not defined } @_;
-    my @types = sort map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
+    return if grep{ not defined } @_; # all things must be defined
+    my @types = sort
+        map{ $_->{type_constraints} ? @{$_->{type_constraints}} : $_ } @_;
 
     my $name = join '|', @types;
 
@@ -388,39 +384,43 @@ sub register_type_constraint {
     my($constraint) = @_;
     Carp::croak("No type supplied / type is not a valid type constraint")
         unless Mouse::Util::is_a_type_constraint($constraint);
-    my $name = $constraint->name;
-    Carp::croak("Can't register an unnamed type constraint")
-        unless defined $name;
-    return $TYPE{$name} = $constraint;
+    return $TYPE{$constraint->name} = $constraint;
 }
 
 sub find_or_parse_type_constraint {
     my($spec) = @_;
     return $spec if Mouse::Util::is_a_type_constraint($spec) or not defined $spec;
 
-    $spec =~ s/\s+//g;
-    return $TYPE{$spec} || do{
-        my $context = {
-            spec => $spec,
-            orig => $spec,
-        };
-        my $type = _parse_type($context);
+    $spec =~ tr/ \t\r\n//d;
 
-        if($context->{spec}){
-            Carp::croak("Syntax error: extra elements '$context->{spec}' in '$context->{orig}'");
-        }
-        $type;
-    };
+    my $tc = $TYPE{$spec};
+    if(defined $tc) {
+        return $tc;
+    }
+
+    my %context = (
+        spec => $spec,
+        orig => $spec,
+    );
+    $tc = _parse_type(\%context);
+
+    if($context{spec}){
+        Carp::croak("Syntax error: extra elements '$context{spec}' in '$context{orig}'");
+    }
+
+    return $TYPE{$spec} = $tc;
 }
 
 sub find_or_create_does_type_constraint{
     # XXX: Moose does not register a new role_type, but Mouse does.
-    return find_or_parse_type_constraint(@_) || role_type(@_);
+    my $tc = find_or_parse_type_constraint(@_);
+    return defined($tc) ? $tc : role_type(@_);
 }
 
 sub find_or_create_isa_type_constraint {
     # XXX: Moose does not register a new class_type, but Mouse does.
-    return find_or_parse_type_constraint(@_) || class_type(@_);
+    my $tc = find_or_parse_type_constraint(@_);
+    return defined($tc) ? $tc : class_type(@_);
 }
 
 1;
@@ -432,7 +432,7 @@ Mouse::Util::TypeConstraints - Type constraint system for Mouse
 
 =head1 VERSION
 
-This document describes Mouse version 0.73
+This document describes Mouse version 0.94
 
 =head2 SYNOPSIS