From: Stevan Little <stevan.little@iinteractive.com>
Date: Sun, 19 Mar 2006 16:26:10 +0000 (+0000)
Subject: basic-type-coercion
X-Git-Tag: 0_05~89
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e90c03d0a4c255314c81687b980b844f8bc48bbe;p=gitmo%2FMoose.git

basic-type-coercion
---

diff --git a/lib/Moose.pm b/lib/Moose.pm
index 1127479..b692b10 100644
--- a/lib/Moose.pm
+++ b/lib/Moose.pm
@@ -77,11 +77,22 @@ sub import {
 			}			
 		}
 		if (exists $options{isa}) {
+		    # allow for anon-subtypes here ...
 		    if (reftype($options{isa}) && reftype($options{isa}) eq 'CODE') {
 				$options{type_constraint} = $options{isa};
 			}
 			else {
-                $options{type_constraint} = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
+			    # otherwise assume it is a constraint
+			    my $constraint = Moose::Util::TypeConstraints::find_type_constraint($options{isa});
+			    # if the constraing it not found ....
+			    unless (defined $constraint) {
+			        # assume it is a foreign class, and make 
+			        # an anon constraint for it 
+			        $constraint = Moose::Util::TypeConstraints::subtype(
+			            Object => Moose::Util::TypeConstraints::where { $_->isa($constraint) }
+                	);
+			    }
+                $options{type_constraint} = $constraint;
 			}
 		}
 		$meta->add_attribute($name, %options) 
@@ -213,6 +224,14 @@ originally, I just ran with it.
 
 =back
 
+=head1 SEE ALSO
+
+=over 4
+
+=item L<http://forum2.org/moose/>
+
+=back
+
 =head1 BUGS
 
 All complex software has bugs lurking in it, and this module is no 
diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm
index 3e6a854..f21e348 100644
--- a/lib/Moose/Util/TypeConstraints.pm
+++ b/lib/Moose/Util/TypeConstraints.pm
@@ -4,6 +4,7 @@ package Moose::Util::TypeConstraints;
 use strict;
 use warnings;
 
+use Carp         'confess';
 use Sub::Name    'subname';
 use Scalar::Util 'blessed';
 
@@ -91,9 +92,24 @@ sub subtype ($$;$) {
 }
 
 sub coerce {
-    my ($type_name, %coercion_map) = @_;
+    my ($type_name, @coercion_map) = @_;
+    my @coercions;
+    while (@coercion_map) {
+        my ($constraint_name, $action) = splice(@coercion_map, 0, 2);
+        my $constraint = find_type_constraint($constraint_name);
+        (defined $constraint)
+            || confess "Could not find the type constraint ($constraint_name)";
+        push @coercions => [  $constraint, $action ];
+    }
     register_type_coercion($type_name, sub { 
-        %coercion_map 
+        my $thing = shift;
+        foreach my $coercion (@coercions) {
+            my ($constraint, $converter) = @$coercion;
+            if (defined $constraint->($thing)) {
+                return $converter->($thing);
+            }
+        }
+        return $thing;
     });
 }
 
diff --git a/t/054_util_type_coercion.t b/t/054_util_type_coercion.t
index 5b9b62e..a981b10 100644
--- a/t/054_util_type_coercion.t
+++ b/t/054_util_type_coercion.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 6;
+use Test::More tests => 14;
 use Test::Exception;
 
 BEGIN {
@@ -42,24 +42,36 @@ ok(!Header({}), '... this did not pass the type test');
 my $coercion = Moose::Util::TypeConstraints::find_type_coercion('Header');
 is(ref($coercion), 'CODE', '... got the right type of coercion');
 
-#{
-#    my $coerced = $coercion->([ 1, 2, 3 ]);
-#    isa_ok($coerced, 'HTTPHeader');
-#
-#    is_deeply(
-#        $coerced->array(),
-#        [ 1, 2, 3 ],
-#        '... got the right array');
-#    is($coerced->hash(), undef, '... nothing assigned to the hash');        
-#}
-#
-#{
-#    my $coerced = $coercion->({ one => 1, two => 2, three => 3 });
-#    isa_ok($coerced, 'HTTPHeader');
-#    
-#    is_deeply(
-#        $coerced->hash(),
-#        { one => 1, two => 2, three => 3 },
-#        '... got the right hash');
-#    is($coerced->array(), undef, '... nothing assigned to the array');        
-#}
+{
+    my $coerced = $coercion->([ 1, 2, 3 ]);
+    isa_ok($coerced, 'HTTPHeader');
+
+    is_deeply(
+        $coerced->array(),
+        [ 1, 2, 3 ],
+        '... got the right array');
+    is($coerced->hash(), undef, '... nothing assigned to the hash');        
+}
+
+{
+    my $coerced = $coercion->({ one => 1, two => 2, three => 3 });
+    isa_ok($coerced, 'HTTPHeader');
+    
+    is_deeply(
+        $coerced->hash(),
+        { one => 1, two => 2, three => 3 },
+        '... got the right hash');
+    is($coerced->array(), undef, '... nothing assigned to the array');        
+}
+
+{
+    my $scalar_ref = \(my $var);
+    my $coerced = $coercion->($scalar_ref);
+    is($coerced, $scalar_ref, '... got back what we put in');
+}
+
+{
+    my $coerced = $coercion->("Foo");
+    is($coerced, "Foo", '... got back what we put in');
+}
+