updated changelog and prepped for release

[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 424527c..4124c39 100644 (file)
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -1,11 +1,13 @@
 package MooseX::Types::Structured;
 
 use 5.008;
+
 use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
 use MooseX::Types -declare => [qw(Dict Tuple Optional)];
+use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
 
-our $VERSION = '0.07';
+our $VERSION = '0.08';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -479,7 +481,63 @@ following are valid:
 
     {first=>'John', middle=>'James', last=>'Napiorkowski'}
     {first=>'Vanessa', last=>'Li'}
+
+=head1 EXPORTABLE SUBROUTINES
+
+This type library makes available for export the following subroutines
+
+=head2 slurpy
+
+Structured type constraints by their nature are closed; that is validation will
+depend and an exact match between your structure definition and the arguments to
+be checked.  Sometimes you might wish for a slightly looser amount of validation.
+For example, you may wish to validate the first 3 elements of an array reference
+and allow for an arbitrary number of additional elements.  At first thought you
+might think you could do it this way:
+
+    #  I want to validate stuff like: [1,"hello", $obj, 2,3,4,5,6,...]
+    subtype AllowTailingArgs,
+     as Tuple[
+       Int,
+       Str,
+       Object,
+       ArrayRef[Int],
+     ];
+
+However what this will actually validate are structures like this:
+
+    [10,"Hello", $obj, [11,12,13,...] ]; # Notice element 4 is an ArrayRef
+
+In order to allow structured validation of, "and then some", arguments, you can
+use the </slurpy> method against a type constraint.  For example:
+
+    use MooseX::Types::Structured qw(Tuple slurpy);
     
+    subtype AllowTailingArgs,
+     as Tuple[
+       Int,
+       Str,
+       Object,
+       slurpy ArrayRef[Int],
+     ];
+
+This will now work as expected, validating ArrayRef structures such as:
+
+    [1,"hello", $obj, 2,3,4,5,6,...]
+    
+A few caveats apply.  First, the slurpy type constraint must be the last one in
+the list of type constraint parameters.  Second, the parent type of the slurpy
+type constraint must match that of the containing type constraint.  That means
+that a Tuple can allow a slurpy ArrayRef (or children of ArrayRefs, including
+another Tuple) and a Dict can allow a slurpy HashRef (or children/subtypes of
+HashRef, also including other Dict constraints).
+
+Please note the the technical way this works 'under the hood' is that the
+slurpy keywork transforms the target type constraint into a coderef.  Please do
+not try to create your own custom coderefs; always use the slurpy method.  The
+underlying technology may change in the future but the slurpy keyword will be
+supported.
+
 =head1 EXAMPLES
 
 Here are some additional example usage for structured types.  All examples can
@@ -572,7 +630,13 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                        ## Get the constraints and values to check
             my ($type_constraints, $values) = @_;
                        my @type_constraints = defined $type_constraints ?
-             @$type_constraints : ();            
+             @$type_constraints : ();
+            
+            my $overflow_handler;
+            if(ref $type_constraints[-1] eq 'CODE') {
+                $overflow_handler = pop @type_constraints;
+            }
+            
                        my @values = defined $values ? @$values: ();
                        ## Perform the checking
                        while(@type_constraints) {
@@ -591,8 +655,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                        }
                        ## Make sure there are no leftovers.
                        if(@values) {
-                warn "I failed since there were left over values";
-                               return;
+                if($overflow_handler) {
+                    return $overflow_handler->([@values]);
+                } else {
+                    return;
+                }
                        } elsif(@type_constraints) {
                 warn "I failed due to left over TC";
                                return;
@@ -610,8 +677,14 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                constraint_generator=> sub { 
                        ## Get the constraints and values to check
             my ($type_constraints, $values) = @_;
-                       my %type_constraints = defined $type_constraints ?
-             @$type_constraints : ();            
+                       my @type_constraints = defined $type_constraints ?
+             @$type_constraints : ();
+            
+            my $overflow_handler;
+            if(ref $type_constraints[-1] eq 'CODE') {
+                $overflow_handler = pop @type_constraints;
+            } 
+            my (%type_constraints) = @type_constraints;
                        my %values = defined $values ? %$values: ();
                        ## Perform the checking
                        while(%type_constraints) {
@@ -632,7 +705,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                        }
                        ## Make sure there are no leftovers.
                        if(%values) { 
-                               return;
+                if($overflow_handler) {
+                    return $overflow_handler->(+{%values});
+                } else {
+                    return;
+                }
                        } elsif(%type_constraints) {
                                return;
                        } else {
@@ -670,6 +747,12 @@ OPTIONAL: {
     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
 }
 
+sub slurpy($) {
+       my $tc = shift @_;
+       return sub {
+        $tc->check(shift);
+    };
+}
 
 =head1 SEE ALSO