X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FUtil%2FTypeConstraints.pm;h=cc36e8e1ca2cd6bc015599d799cef873beb2833f;hb=183ba44e79132094cc1cb595fcf206f24365a778;hp=ef2d9d83f74370d89a77dfcb4a5ad426a6aa74a6;hpb=c2a69ef1a5adb302bcb6ca0a2623f75f195d348e;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index ef2d9d8..cc36e8e 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype';
 use B            'svref_2object';
 use Sub::Exporter;
 
-our $VERSION   = '0.13';
+our $VERSION   = '0.14';
 our $AUTHORITY = 'cpan:STEVAN';
 
 # Prototyped subs must be predeclared because we have a circular dependency
@@ -17,23 +17,24 @@ our $AUTHORITY = 'cpan:STEVAN';
 # predeclaration ensures the prototypes are in scope when consumers are
 # compiled
 
-sub find_type_constraint ($);
-sub _create_type_constraint ($$$;$$);
-sub _install_type_coercions ($$);
+sub find_type_constraint         ($);
+sub _create_type_constraint      ($$$;$$);
+sub _install_type_coercions      ($$);
 sub create_type_constraint_union (@);
-sub type ($$;$$);
-sub subtype ($$;$$$);
-sub coerce ($@);
-sub as      ($);
-sub from    ($);
-sub where   (&);
-sub via     (&);
-sub message     (&);
-sub optimize_as (&);
-sub enum ($;@);
+sub type                         ($$;$$);
+sub subtype                      ($$;$$$);
+sub coerce                       ($@);
+sub as                           ($);
+sub from                         ($);
+sub where                        (&);
+sub via                          (&);
+sub message                      (&);
+sub optimize_as                  (&);
+sub enum                         ($;@);
 
 use Moose::Meta::TypeConstraint;
 use Moose::Meta::TypeCoercion;
+use Moose::Meta::TypeConstraint::Registry;
 
 my @exports = qw/
     type subtype as where message optimize_as
@@ -67,84 +68,94 @@ sub unimport {
     }
 }
 
-{
-    my %TYPES;
-    sub find_type_constraint ($) { 
-        return $TYPES{$_[0]}->[1] 
-            if exists $TYPES{$_[0]};
-        return;
-    }
-    
-    sub _dump_type_constraints {
-        require Data::Dumper;        
-        Data::Dumper::Dumper(\%TYPES);
-    }
-    
-    sub _create_type_constraint ($$$;$$) { 
-        my $name   = shift;
-        my $parent = shift;
-        my $check  = shift || sub { 1 };
-        
-        my ($message, $optimized);
-        for (@_) {
-            $message   = $_->{message}   if exists $_->{message};
-            $optimized = $_->{optimized} if exists $_->{optimized};            
-        }
+my $REGISTRY = Moose::Meta::TypeConstraint::Registry->new;
 
-        my $pkg_defined_in = scalar(caller(0));
-        
-        ($TYPES{$name}->[0] eq $pkg_defined_in)
-            || confess ("The type constraint '$name' has already been created in " 
-                       . $TYPES{$name}->[0] . " and cannot be created again in "
-                       . $pkg_defined_in)
-                 if defined $name && exists $TYPES{$name};   
-                              
-        $parent = find_type_constraint($parent) if defined $parent;
-        my $constraint = Moose::Meta::TypeConstraint->new(
-            name       => $name || '__ANON__',
-            parent     => $parent,            
-            constraint => $check,       
-            message    => $message,    
-            optimized  => $optimized,
-        );
-        $TYPES{$name} = [ $pkg_defined_in, $constraint ] if defined $name;
-        return $constraint;
-    }
+sub _get_type_constraint_registry { $REGISTRY }
+sub _dump_type_constraints        { $REGISTRY->dump }
 
-    sub _install_type_coercions ($$) { 
-        my ($type_name, $coercion_map) = @_;
-        my $type = find_type_constraint($type_name);
-        (!$type->has_coercion)
-            || confess "The type coercion for '$type_name' has already been registered";        
-        my $type_coercion = Moose::Meta::TypeCoercion->new(
-            type_coercion_map => $coercion_map,
-            type_constraint   => $type
-        );            
-        $type->coercion($type_coercion);
-    }
+# NOTE:
+# this method breaks down the sugar 
+# from the functions below.
+sub _create_type_constraint ($$$;$$) { 
+    my $name   = shift;
+    my $parent = shift;
+    my $check  = shift || sub { 1 };
     
-    sub create_type_constraint_union (@) {
-        my (@type_constraint_names) = @_;
-        return Moose::Meta::TypeConstraint->union(
-            map { 
-                find_type_constraint($_) 
-            } @type_constraint_names
-        );
+    my ($message, $optimized);
+    for (@_) {
+        $message   = $_->{message}   if exists $_->{message};
+        $optimized = $_->{optimized} if exists $_->{optimized};            
     }
+
+    my $pkg_defined_in = scalar(caller(0));
     
-    sub export_type_constraints_as_functions {
-        my $pkg = caller();
-	    no strict 'refs';
-    	foreach my $constraint (keys %TYPES) {
-    		*{"${pkg}::${constraint}"} = find_type_constraint($constraint)->_compiled_type_constraint;
-    	}        
-    }
+    if (defined $name) {
+        my $type = $REGISTRY->get_type_constraint($name);
     
-    *Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
+        ($type->_package_defined_in eq $pkg_defined_in)
+            || confess ("The type constraint '$name' has already been created in " 
+                       . $type->_package_defined_in . " and cannot be created again in "
+                       . $pkg_defined_in)
+                 if defined $type;   
+    }                    
+                          
+    $parent = $REGISTRY->get_type_constraint($parent) if defined $parent;
     
-    sub list_all_type_constraints { keys %TYPES }   
+    my $constraint = Moose::Meta::TypeConstraint->new(
+        name               => $name || '__ANON__',
+        parent             => $parent,            
+        constraint         => $check,       
+        message            => $message,    
+        optimized          => $optimized,
+        package_defined_in => $pkg_defined_in,
+    );
+
+    $REGISTRY->add_type_constraint($constraint)
+        if defined $name;
+
+    return $constraint;
+}
+
+sub _install_type_coercions ($$) { 
+    my ($type_name, $coercion_map) = @_;
+    my $type = $REGISTRY->get_type_constraint($type_name);
+    (!$type->has_coercion)
+        || confess "The type coercion for '$type_name' has already been registered";        
+    my $type_coercion = Moose::Meta::TypeCoercion->new(
+        type_coercion_map => $coercion_map,
+        type_constraint   => $type
+    );            
+    $type->coercion($type_coercion);
+}
+
+sub create_type_constraint_union (@) {
+    my (@type_constraint_names) = @_;
+    return Moose::Meta::TypeConstraint->union(
+        map { 
+            $REGISTRY->get_type_constraint($_) 
+        } @type_constraint_names
+    );
 }
 
+sub export_type_constraints_as_functions {
+    my $pkg = caller();
+    no strict 'refs';
+	foreach my $constraint (keys %{$REGISTRY->type_constraints}) {
+		*{"${pkg}::${constraint}"} = $REGISTRY->get_type_constraint($constraint)
+		                                      ->_compiled_type_constraint;
+	}        
+}
+
+*Moose::Util::TypeConstraints::export_type_contstraints_as_functions = \&export_type_constraints_as_functions;
+
+sub list_all_type_constraints { keys %{$REGISTRY->type_constraints} }   
+
+## --------------------------------------------------------
+## exported functions ...
+## --------------------------------------------------------
+
+sub find_type_constraint ($) { $REGISTRY->get_type_constraint(@_) }
+
 # type constructors
 
 sub type ($$;$$) {