finished Optional, wrote docs and tests for it
[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm
index cb688e6..6063e4c 100644 (file)
@@ -4,9 +4,9 @@ use 5.008;
 use Moose;
 use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
-use MooseX::Types -declare => [qw(Dict Tuple)];
+use MooseX::Types -declare => [qw(Dict Tuple Optional)];
 
-our $VERSION = '0.05';
+our $VERSION = '0.06';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -21,16 +21,31 @@ The following is example usage for this module.
        
     use Moose;
     use MooseX::Types::Moose qw(Str Int);
-    use MooseX::Types::Structured qw(Dict Tuple);
-
-    has name => (isa=>Dict[first_name=>Str, last_name=>Str]);
+    use MooseX::Types::Structured qw(Dict Optional);
+
+    ## A name has a first and last part, but middle names are not required
+    has name => (
+        isa=>Dict[
+            first=>Str,
+            last=>Str,
+            middle=>Optional[Str],
+        ],
+    );
 
 Then you can instantiate this class with something like:
 
-    my $instance = MyApp::MyClass->new(
+    my $john = MyApp::MyClass->new(
         name => {
-            first_name=>'John', 
-            last_name=>'Napiorkowski',
+            first=>'John',
+            middle=>'James'
+            last=>'Napiorkowski',
+        },
+    );
+    
+    my $vanessa = MyApp::MyClass->new(
+        name => {
+            first=>'Vanessa',
+            last=>'Li'
         },
     );
 
@@ -39,7 +54,8 @@ But all of these would cause a constraint error for the 'name' attribute:
     MyApp::MyClass->new( name=>'John' );
     MyApp::MyClass->new( name=>{first_name=>'John'} );
     MyApp::MyClass->new( name=>{first_name=>'John', age=>39} );
-
+    MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} );
+    
 Please see the test cases for more examples.
 
 =head1 DESCRIPTION
@@ -215,6 +231,29 @@ hashref.  For example:
 
     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
 
+=head2 Optional [$constraint]
+
+This is primarily a helper constraint for Dict and Tuple type constraints.  What
+this allows if for you to assert that a given type constraint is allowed to be
+null (but NOT undefined).  If the value is null, then the type constraint passes
+but if the value is defined it must validate against the type constraint.  This
+makes it easy to make a Dict where one or more of the keys doesn't have to exist
+or a tuple where some of the values are not required.  For example:
+
+    subtype Name() => as Dict[
+        first=>Str,
+        last=>Str,
+        middle=>Optional[Str],
+    ];
+        
+Creates a constraint that validates against a hashref with the keys 'first' and
+'last' being strings and required while an optional key 'middle' is must be a
+string if it appears but doesn't have to appear.  So in this case both the
+following are valid:
+
+    {first=>'John', middle=>'James', last=>'Napiorkowski'}
+    {first=>'Vanessa', last=>'Li'}
+    
 =head1 EXAMPLES
 
 Here are some additional example usage for structured types.  All examples can
@@ -260,10 +299,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        MooseX::Meta::TypeConstraint::Structured->new(
                name => "MooseX::Types::Structured::Tuple" ,
                parent => find_type_constraint('ArrayRef'),
-               constraint_generator=> sub {
+               constraint_generator=> sub { 
                        ## Get the constraints and values to check
-                       my @type_constraints = @{shift @_};            
-                       my @values = @{shift @_};
+            my ($type_constraints, $values) = @_;
+                       my @type_constraints = defined $type_constraints ? @$type_constraints: ();            
+                       my @values = defined $values ? @$values: ();
                        ## Perform the checking
                        while(@type_constraints) {
                                my $type_constraint = shift @type_constraints;
@@ -273,7 +313,9 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                                return;
                                        }                               
                                } else {
-                                       return;
+                                       unless($type_constraint->check()) {
+                                               return;
+                                       }
                                }
                        }
                        ## Make sure there are no leftovers.
@@ -292,10 +334,11 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        MooseX::Meta::TypeConstraint::Structured->new(
                name => "MooseX::Types::Structured::Dict",
                parent => find_type_constraint('HashRef'),
-               constraint_generator=> sub {
+               constraint_generator=> sub { 
                        ## Get the constraints and values to check
-                       my %type_constraints = @{shift @_};            
-                       my %values = %{shift @_};
+            my ($type_constraints, $values) = @_;
+                       my %type_constraints = defined $type_constraints ? @$type_constraints: ();            
+                       my %values = defined $values ? %$values: ();
                        ## Perform the checking
                        while(%type_constraints) {
                                my($key, $type_constraint) = each %type_constraints;
@@ -306,12 +349,14 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        unless($type_constraint->check($value)) {
                                                return;
                                        }
-                               } else {
-                                       return;
+                               } else { 
+                                       unless($type_constraint->check()) {
+                                               return;
+                                       }
                                }
                        }
                        ## Make sure there are no leftovers.
-                       if(%values) {
+                       if(%values) { 
                                return;
                        } elsif(%type_constraints) {
                                return;
@@ -322,6 +367,33 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
        )
 );
 
+OPTIONAL: {
+    my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
+        name => 'MooseX::Types::Structured::Optional',
+        package_defined_in => __PACKAGE__,
+        parent => find_type_constraint('Item'),
+        constraint => sub { 1 },
+        constraint_generator => sub {
+            my ($type_parameter, @args) = @_;
+            my $check = $type_parameter->_compiled_type_constraint();
+            return sub {
+                my (@args) = @_;                       
+                if(exists($args[0])) {
+                    ## If it exists, we need to validate it
+                    $check->($args[0]);
+                } else {
+                    ## But it's is okay if the value doesn't exists
+                    return 1;
+                }
+            }
+        }
+    );
+
+    Moose::Util::TypeConstraints::register_type_constraint($Optional);
+    Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+}
+
+
 =head1 SEE ALSO
 
 The following modules or resources may be of interest.