X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=ccb08442c8809e1e79abf003071f3769b64b8ad1;hb=ffa6bd15653d24cb3197fb7d2a7cdd6726248524;hp=848cc3f2413cd13e04ee8e472a05783cdad76cca;hpb=107df03f2098e51e912e6435235eeb71d5820a95;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 848cc3f..ccb0844 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -4,11 +4,13 @@ use 5.008;
 
 use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Types::Structured::OverflowHandler;
 use MooseX::Types -declare => [qw(Dict Tuple Optional)];
 use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
 use Devel::PartialDump;
+use Scalar::Util qw(blessed);
 
-our $VERSION = '0.122';
+our $VERSION = '0.155555';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -657,7 +659,8 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
              @$type_constraints : ();
             
             my $overflow_handler;
-            if(ref $type_constraints[-1] eq 'CODE') {
+            if($type_constraints[-1] && blessed $type_constraints[-1]
+              && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
                 $overflow_handler = pop @type_constraints;
             }
             
@@ -684,7 +687,7 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 			## Make sure there are no leftovers.
 			if(@values) {
                 if($overflow_handler) {
-                    return $overflow_handler->([@values], $_[2]);
+                    return $overflow_handler->check([@values], $_[2]);
                 } else {
                     $_[2]->{message} = "More values than Type Constraints!"
                      if ref $_[2];
@@ -713,7 +716,8 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
              @$type_constraints : ();
             
             my $overflow_handler;
-            if(ref $type_constraints[-1] eq 'CODE') {
+            if($type_constraints[-1] && blessed $type_constraints[-1]
+              && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
                 $overflow_handler = pop @type_constraints;
             } 
             my (%type_constraints) = @type_constraints;
@@ -742,7 +746,7 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 			## Make sure there are no leftovers.
 			if(%values) { 
                 if($overflow_handler) {
-                    return $overflow_handler->(+{%values});
+                    return $overflow_handler->check(+{%values});
                 } else {
                     $_[2]->{message} = "More values than Type Constraints!"
                      if ref $_[2];
@@ -788,11 +792,11 @@ OPTIONAL: {
     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
 }
 
-sub slurpy($) {
-	my $tc = shift @_;
-	return sub {
-        $tc->check(shift);
-    };
+sub slurpy ($) {
+	my ($tc) = @_;
+	return MooseX::Types::Structured::OverflowHandler->new(
+        type_constraint => $tc,
+    );
 }
 
 =head1 SEE ALSO
@@ -810,14 +814,24 @@ All POD examples need test cases in t/documentation/*.t
 Want to break out the examples section to a separate cookbook style POD.
 Want more examples and best practice / usage guidance for authors
 Need to clarify deep coercions, 
-Need to clarify subtypes of subtypes.
 
 =head1 AUTHOR
 
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
+
 John Napiorkowski, C<< <jjnapiork@cpan.org> >>
 
+=head1 CONTRIBUTORS
+
+The Following people have contributed to this module:
+
+    Florian Ragwitz, C<< <rafl@debian.org> >>
+    Yuval Kogman, C<< <nothingmuch@woobling.org> >>
+
 =head1 COPYRIGHT & LICENSE
 
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
+
 This program is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.