add a map type
[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm
1 package MooseX::Types::Structured;
2
3 use 5.008;
4
5 use Moose::Util::TypeConstraints;
6 use MooseX::Meta::TypeConstraint::Structured;
7 use MooseX::Types::Structured::OverflowHandler;
8 use MooseX::Types -declare => [qw(Dict Map Tuple Optional)];
9 use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ];
10 use Devel::PartialDump;
11 use Scalar::Util qw(blessed);
12
13 our $VERSION = '0.19';
14 our $AUTHORITY = 'cpan:JJNAPIORK';
15
16 =head1 NAME
17
18 MooseX::Types::Structured - Structured Type Constraints for Moose
19
20 =head1 SYNOPSIS
21
22 The following is example usage for this module.
23
24     package Person;
25         
26     use Moose;
27     use MooseX::Types::Moose qw(Str Int HashRef);
28     use MooseX::Types::Structured qw(Dict Tuple Optional);
29
30     ## A name has a first and last part, but middle names are not required
31     has name => (
32         isa=>Dict[
33             first => Str,
34             last => Str,
35             middle => Optional[Str],
36         ],
37     );
38     
39     ## description is a string field followed by a HashRef of tagged data.
40     has description => (
41       isa=>Tuple[
42         Str,
43         Optional[HashRef],
44      ],
45     );
46
47         ## Remainder of your class attributes and methods
48
49 Then you can instantiate this class with something like:
50
51     my $john = Person->new(
52         name => {
53             first => 'John',
54             middle => 'James'
55             last => 'Napiorkowski',
56         },
57         description => [
58             'A cool guy who loves Perl and Moose.', {
59                 married_to => 'Vanessa Li',
60                 born_in => 'USA',
61             };
62         ]
63     );
64
65 Or with:
66
67     my $vanessa = Person->new(
68         name => {
69             first => 'Vanessa',
70             last => 'Li'
71         },
72         description => ['A great student!'],
73     );
74
75 But all of these would cause a constraint error for the 'name' attribute:
76
77     ## Value for 'name' not a HashRef
78     Person->new( name => 'John' );
79     
80     ## Value for 'name' has incorrect hash key and missing required keys
81     Person->new( name => {
82         first_name => 'John'
83     });
84     
85     ## Also incorrect keys
86     Person->new( name => {
87         first_name => 'John',
88         age => 39,
89     });
90     
91     ## key 'middle' incorrect type, should be a Str not a ArrayRef
92     Person->new( name => {
93         first => 'Vanessa',
94         middle => [1,2],
95         last => 'Li',
96     }); 
97
98 And these would cause a constraint error for the 'description' attribute:
99
100     ## Should be an ArrayRef
101     Person->new( description => 'Hello I am a String' );
102     
103     ## First element must be a string not a HashRef.
104     Person->new (description => [{
105         tag1 => 'value1',
106         tag2 => 'value2'
107     }]);
108
109 Please see the test cases for more examples.
110
111 =head1 DESCRIPTION
112
113 A structured type constraint is a standard container L<Moose> type constraint,
114 such as an ArrayRef or HashRef, which has been enhanced to allow you to
115 explicitly name all the allowed type constraints inside the structure.  The
116 generalized form is:
117
118     TypeConstraint[@TypeParameters or %TypeParameters]
119
120 Where 'TypeParameters' is an array reference or hash references of 
121 L<Moose::Meta::TypeConstraint> objects.
122
123 This type library enables structured type constraints. It is built on top of the
124 L<MooseX::Types> library system, so you should review the documentation for that
125 if you are not familiar with it.
126
127 =head2 Comparing Parameterized types to Structured types
128
129 Parameterized constraints are built into core Moose and you are probably already
130 familar with the type constraints 'HashRef' and 'ArrayRef'.  Structured types
131 have similar functionality, so their syntax is likewise similar. For example,
132 you could define a parameterized constraint like:
133
134     subtype ArrayOfInts,
135      as ArrayRef[Int];
136
137 which would constrain a value to something like [1,2,3,...] and so on.  On the
138 other hand, a structured type constraint explicitly names all it's allowed
139 'internal' type parameter constraints.  For the example:
140
141     subtype StringFollowedByInt,
142      as Tuple[Str,Int];
143         
144 would constrain it's value to things like ['hello', 111] but ['hello', 'world']
145 would fail, as well as ['hello', 111, 'world'] and so on.  Here's another
146 example:
147
148         package MyApp::Types;
149
150     use MooseX::Types -declare [qw(StringIntOptionalHashRef)];
151     use MooseX::Types::Moose qw(Str Int);
152         use MooseX::Types::Structured qw(Tuple Optional);
153
154     subtype StringIntOptionalHashRef,
155      as Tuple[
156         Str, Int,
157         Optional[HashRef]
158      ];
159      
160 This defines a type constraint that validates values like:
161
162     ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
163     ['World', 200];
164     
165 Notice that the last type constraint in the structure is optional.  This is
166 enabled via the helper Optional type constraint, which is a variation of the
167 core Moose type constraint 'Maybe'.  The main difference is that Optional type
168 constraints are required to validate if they exist, while 'Maybe' permits 
169 undefined values.  So the following example would not validate:
170
171     StringIntOptionalHashRef->validate(['Hello Undefined', 1000, undef]);
172     
173 Please note the subtle difference between undefined and null.  If you wish to
174 allow both null and undefined, you should use the core Moose 'Maybe' type
175 constraint instead:
176
177         package MyApp::Types;
178
179     use MooseX::Types -declare [qw(StringIntMaybeHashRef)];
180     use MooseX::Types::Moose qw(Str Int Maybe);
181     use MooseX::Types::Structured qw(Tuple);
182
183     subtype StringIntMaybeHashRef,
184      as Tuple[
185         Str, Int, Maybe[HashRef]
186      ];
187
188 This would validate the following:
189
190     ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
191     ['World', 200, undef];    
192     ['World', 200];
193
194 Structured constraints are not limited to arrays.  You can define a structure
195 against a HashRef with the 'Dict' type constaint as in this example:
196
197     subtype FirstNameLastName,
198      as Dict[
199         firstname => Str,
200         lastname => Str,
201      ];
202
203 This would constrain a HashRef that validates something like:
204
205     {firstname => 'Christopher', lastname => 'Parsons'};
206     
207 but all the following would fail validation:
208
209     ## Incorrect keys
210     {first => 'Christopher', last => 'Parsons'};
211     
212     ## Too many keys
213     {firstname => 'Christopher', lastname => 'Parsons', middlename => 'Allen'};
214     
215     ## Not a HashRef
216     ['Christopher', 'Parsons']; 
217
218 These structures can be as simple or elaborate as you wish.  You can even
219 combine various structured, parameterized and simple constraints all together:
220
221     subtype Crazy,
222      as Tuple[
223         Int,
224         Dict[name=>Str, age=>Int],
225         ArrayRef[Int]
226      ];
227         
228 Which would match:
229
230         [1, {name=>'John', age=>25},[10,11,12]];
231
232 Please notice how the type parameters can be visually arranged to your liking
233 and to improve the clarity of your meaning.  You don't need to run then 
234 altogether onto a single line.  Additionally, since the 'Dict' type constraint
235 defines a hash constraint, the key order is not meaningful.  For example:
236
237         subtype AnyKeyOrder,
238          as Dict[
239                 key1=>Int,
240                 key2=>Str,
241                 key3=>Int,
242          ];
243
244 Would validate both:
245
246         {key1 => 1, key2 => "Hi!", key3 => 2};
247         {key2 => "Hi!", key1 => 100, key3 => 300};
248
249 As you would expect, since underneath its just a plain old Perl hash at work.
250
251 =head2 Alternatives
252
253 You should exercise some care as to whether or not your complex structured
254 constraints would be better off contained by a real object as in the following
255 example:
256
257     package MyApp::MyStruct;
258     use Moose;
259     
260     ## lazy way to make a bunch of attributes
261     has $_ for qw(full_name age_in_years);
262     
263     package MyApp::MyClass;
264     use Moose;
265     
266     has person => (isa => 'MyApp::MyStruct');           
267     
268     my $instance = MyApp::MyClass->new(
269         person=>MyApp::MyStruct->new(
270             full_name => 'John',
271             age_in_years => 39,
272         ),
273     );
274         
275 This method may take some additional time to setup but will give you more
276 flexibility.  However, structured constraints are highly compatible with this
277 method, granting some interesting possibilities for coercion.  Try:
278
279     package MyApp::MyClass;
280     
281     use Moose;
282     use MyApp::MyStruct;
283     
284     ## It's recommended your type declarations live in a separate class in order
285     ## to promote reusability and clarity.  Inlined here for brevity.
286     
287     use MooseX::Types::DateTime qw(DateTime);
288     use MooseX::Types -declare [qw(MyStruct)];
289     use MooseX::Types::Moose qw(Str Int);
290     use MooseX::Types::Structured qw(Dict);
291
292     ## Use class_type to create an ISA type constraint if your object doesn't
293     ## inherit from Moose::Object.
294     class_type 'MyApp::MyStruct';
295
296     ## Just a shorter version really.
297     subtype MyStruct,
298      as 'MyApp::MyStruct';
299     
300     ## Add the coercions.
301     coerce MyStruct,
302      from Dict[
303         full_name=>Str,
304         age_in_years=>Int
305      ], via {
306         MyApp::MyStruct->new(%$_);
307      },
308      from Dict[
309         lastname=>Str,
310         firstname=>Str,
311         dob=>DateTime
312      ], via {
313         my $name = $_->{firstname} .' '. $_->{lastname};
314         my $age = DateTime->now - $_->{dob};
315         
316         MyApp::MyStruct->new(
317             full_name=>$name,
318             age_in_years=>$age->years,
319         );
320      };
321      
322     has person => (isa=>MyStruct);      
323      
324 This would allow you to instantiate with something like:
325
326     my $obj = MyApp::MyClass->new( person => {
327         full_name=>'John Napiorkowski',
328         age_in_years=>39,
329     });
330     
331 Or even:
332
333     my $obj = MyApp::MyClass->new( person => {
334         lastname=>'John',
335         firstname=>'Napiorkowski',
336         dob=>DateTime->new(year=>1969),
337     });
338
339 If you are not familiar with how coercions work, check out the L<Moose> cookbook
340 entry L<Moose::Cookbook::Recipe5> for an explanation.  The section L</Coercions>
341 has additional examples and discussion.
342
343 =head2 Subtyping a Structured type constraint
344
345 You need to exercise some care when you try to subtype a structured type as in
346 this example:
347
348     subtype Person,
349      as Dict[name => Str];
350          
351     subtype FriendlyPerson,
352      as Person[
353         name => Str,
354         total_friends => Int,
355      ];
356          
357 This will actually work BUT you have to take care that the subtype has a
358 structure that does not contradict the structure of it's parent.  For now the
359 above works, but I will clarify the syntax for this at a future point, so
360 it's recommended to avoid (should not really be needed so much anyway).  For
361 now this is supported in an EXPERIMENTAL way.  Your thoughts, test cases and
362 patches are welcomed for discussion.  If you find a good use for this, please
363 let me know.
364
365 =head2 Coercions
366
367 Coercions currently work for 'one level' deep.  That is you can do:
368
369     subtype Person,
370      as Dict[
371         name => Str,
372         age => Int
373     ];
374     
375     subtype Fullname,
376      as Dict[
377         first => Str,
378         last => Str
379      ];
380     
381     coerce Person,
382      ## Coerce an object of a particular class
383      from BlessedPersonObject, via {
384         +{
385             name=>$_->name,
386             age=>$_->age,
387         };
388      },
389      
390      ## Coerce from [$name, $age]
391      from ArrayRef, via {
392         +{
393             name=>$_->[0],
394             age=>$_->[1],
395         },
396      },
397      ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
398      from Dict[fullname=>Fullname, dob=>DateTime], via {
399         my $age = $_->dob - DateTime->now;
400         my $firstn = $_->{fullname}->{first};
401         my $lastn = $_->{fullname}->{last}
402         +{
403             name => $_->{fullname}->{first} .' '. ,
404             age =>$age->years
405         }
406      };
407          
408 And that should just work as expected.  However, if there are any 'inner'
409 coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
410 won't currently get activated.
411
412 Please see the test '07-coerce.t' for a more detailed example.  Discussion on
413 extending coercions to support this welcome on the Moose development channel or
414 mailing list.
415
416 =head2 Recursion
417
418 Newer versions of L<MooseX::Types> support recursive type constraints.  That is
419 you can include a type constraint as a contained type constraint of itself.  For
420 example:
421
422         subtype Person,
423          as Dict[
424                 name=>Str,
425                 friends=>Optional[
426                         ArrayRef[Person]
427                 ],
428          ];
429          
430 This would declare a Person subtype that contains a name and an optional
431 ArrayRef of Persons who are friends as in:
432
433         {
434                 name => 'Mike',
435                 friends => [
436                         { name => 'John' },
437                         { name => 'Vincent' },
438                         {
439                                 name => 'Tracey',
440                                 friends => [
441                                         { name => 'Stephenie' },
442                                         { name => 'Ilya' },
443                                 ],
444                         },
445                 ],
446         };
447
448 Please take care to make sure the recursion node is either Optional, or declare
449 a Union with an non recursive option such as:
450
451         subtype Value
452          as Tuple[
453                 Str,
454                 Str|Tuple,
455          ];
456          
457 Which validates:
458
459         [
460                 'Hello', [
461                         'World', [
462                                 'Is', [
463                                         'Getting',
464                                         'Old',
465                                 ],
466                         ],
467                 ],
468         ];
469
470 Otherwise you will define a subtype thatis impossible to validate since it is 
471 infinitely recursive.  For more information about defining recursive types,
472 please see the documentation in L<MooseX::Types> and the test cases.
473
474 =head1 TYPE CONSTRAINTS
475
476 This type library defines the following constraints.
477
478 =head2 Tuple[@constraints]
479
480 This defines an ArrayRef based constraint which allows you to validate a specific
481 list of contained constraints.  For example:
482
483     Tuple[Int,Str]; ## Validates [1,'hello']
484     Tuple[Str|Object, Int]; ## Validates ['hello', 1] or [$object, 2]
485
486 The Values of @constraints should ideally be L<MooseX::Types> declared type
487 constraints.  We do support 'old style' L<Moose> string based constraints to a
488 limited degree but these string type constraints are considered deprecated.
489 There will be limited support for bugs resulting from mixing string and 
490 L<MooseX::Types> in your structures.  If you encounter such a bug and really
491 need it fixed, we will required a detailed test case at the minimum.
492
493 =head2 Dict[%constraints]
494
495 This defines a HashRef based constraint which allowed you to validate a specific
496 hashref.  For example:
497
498     Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
499
500 The keys in %constraints follow the same rules as @constraints in the above 
501 section.
502
503 =head2 Optional[$constraint]
504
505 This is primarily a helper constraint for Dict and Tuple type constraints.  What
506 this allows is for you to assert that a given type constraint is allowed to be
507 null (but NOT undefined).  If the value is null, then the type constraint passes
508 but if the value is defined it must validate against the type constraint.  This
509 makes it easy to make a Dict where one or more of the keys doesn't have to exist
510 or a tuple where some of the values are not required.  For example:
511
512     subtype Name() => as Dict[
513         first=>Str,
514         last=>Str,
515         middle=>Optional[Str],
516     ];
517         
518 Creates a constraint that validates against a hashref with the keys 'first' and
519 'last' being strings and required while an optional key 'middle' is must be a
520 string if it appears but doesn't have to appear.  So in this case both the
521 following are valid:
522
523     {first=>'John', middle=>'James', last=>'Napiorkowski'}
524     {first=>'Vanessa', last=>'Li'}
525
526 If you use the 'Maybe' type constraint instead, your values will also validate
527 against 'undef', which may be incorrect for you.
528
529 =head1 EXPORTABLE SUBROUTINES
530
531 This type library makes available for export the following subroutines
532
533 =head2 slurpy
534
535 Structured type constraints by their nature are closed; that is validation will
536 depend on an exact match between your structure definition and the arguments to
537 be checked.  Sometimes you might wish for a slightly looser amount of validation.
538 For example, you may wish to validate the first 3 elements of an array reference
539 and allow for an arbitrary number of additional elements.  At first thought you
540 might think you could do it this way:
541
542     #  I want to validate stuff like: [1,"hello", $obj, 2,3,4,5,6,...]
543     subtype AllowTailingArgs,
544      as Tuple[
545        Int,
546        Str,
547        Object,
548        ArrayRef[Int],
549      ];
550
551 However what this will actually validate are structures like this:
552
553     [10,"Hello", $obj, [11,12,13,...] ]; # Notice element 4 is an ArrayRef
554
555 In order to allow structured validation of, "and then some", arguments, you can
556 use the L</slurpy> method against a type constraint.  For example:
557
558     use MooseX::Types::Structured qw(Tuple slurpy);
559     
560     subtype AllowTailingArgs,
561      as Tuple[
562        Int,
563        Str,
564        Object,
565        slurpy ArrayRef[Int],
566      ];
567
568 This will now work as expected, validating ArrayRef structures such as:
569
570     [1,"hello", $obj, 2,3,4,5,6,...]
571     
572 A few caveats apply.  First, the slurpy type constraint must be the last one in
573 the list of type constraint parameters.  Second, the parent type of the slurpy
574 type constraint must match that of the containing type constraint.  That means
575 that a Tuple can allow a slurpy ArrayRef (or children of ArrayRefs, including
576 another Tuple) and a Dict can allow a slurpy HashRef (or children/subtypes of
577 HashRef, also including other Dict constraints).
578
579 Please note the the technical way this works 'under the hood' is that the
580 slurpy keyword transforms the target type constraint into a coderef.  Please do
581 not try to create your own custom coderefs; always use the slurpy method.  The
582 underlying technology may change in the future but the slurpy keyword will be
583 supported.
584
585 =head1 ERROR MESSAGES
586
587 Error reporting has been improved to return more useful debugging messages. Now
588 I will stringify the incoming check value with L<Devel::PartialDump> so that you
589 can see the actual structure that is tripping up validation.  Also, I report the
590 'internal' validation error, so that if a particular element inside the
591 Structured Type is failing validation, you will see that.  There's a limit to
592 how deep this internal reporting goes, but you shouldn't see any of the "failed
593 with ARRAY(XXXXXX)" that we got with earlier versions of this module.
594
595 This support is continuing to expand, so it's best to use these messages for
596 debugging purposes and not for creating messages that 'escape into the wild'
597 such as error messages sent to the user.
598
599 Please see the test '12-error.t' for a more lengthy example.  Your thoughts and
600 preferable tests or code patches very welcome!
601
602 =head1 EXAMPLES
603
604 Here are some additional example usage for structured types.  All examples can
605 be found also in the 't/examples.t' test.  Your contributions are also welcomed.
606
607 =head2 Normalize a HashRef
608
609 You need a hashref to conform to a canonical structure but are required accept a
610 bunch of different incoming structures.  You can normalize using the Dict type
611 constraint and coercions.  This example also shows structured types mixed which
612 other MooseX::Types libraries.
613
614     package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
615     
616     use Moose;
617     use DateTime;
618     
619     use MooseX::Types::Structured qw(Dict Tuple);
620     use MooseX::Types::DateTime qw(DateTime);
621     use MooseX::Types::Moose qw(Int Str Object);
622     use MooseX::Types -declare => [qw(Name Age Person)];
623      
624     subtype Person,
625      as Dict[
626         name=>Str,
627         age=>Int,
628      ];
629     
630     coerce Person,
631      from Dict[
632         first=>Str, 
633         last=>Str, 
634         years=>Int,
635      ], via { +{
636         name => "$_->{first} $_->{last}",
637         age => $_->{years},
638      }},
639      from Dict[
640         fullname=>Dict[
641                 last=>Str, 
642                 first=>Str,
643         ], 
644         dob=>DateTime,
645      ],
646      ## DateTime needs to be inside of single quotes here to disambiguate the
647      ## class package from the DataTime type constraint imported via the
648      ## line "use MooseX::Types::DateTime qw(DateTime);"
649      via { +{
650         name => "$_->{fullname}{first} $_->{fullname}{last}",
651         age => ($_->{dob} - 'DateTime'->now)->years,
652      }};
653      
654     has person => (is=>'rw', isa=>Person, coerce=>1);
655     
656 And now you can instantiate with all the following:
657
658     __PACKAGE__->new(
659         person=>{
660             name=>'John Napiorkowski',
661             age=>39,            
662         },
663     );
664         
665     __PACKAGE__->new(
666         person=>{
667             first=>'John',
668             last=>'Napiorkowski',
669             years=>39,
670         },
671     );
672     
673     __PACKAGE__->new(
674         person=>{
675             fullname => {
676                 first=>'John',
677                 last=>'Napiorkowski'
678             },
679             dob => 'DateTime'->new(
680                 year=>1969,
681                 month=>2,
682                 day=>13
683             ),            
684         },
685     );
686     
687 This technique is a way to support various ways to instantiate your class in a
688 clean and declarative way.
689
690 =cut
691
692 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
693         MooseX::Meta::TypeConstraint::Structured->new(
694                 name => "MooseX::Types::Structured::Tuple" ,
695                 parent => find_type_constraint('ArrayRef'),
696                 constraint_generator=> sub { 
697                         ## Get the constraints and values to check
698             my ($type_constraints, $values) = @_;
699                         my @type_constraints = defined $type_constraints ?
700              @$type_constraints : ();
701             
702             my $overflow_handler;
703             if($type_constraints[-1] && blessed $type_constraints[-1]
704               && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
705                 $overflow_handler = pop @type_constraints;
706             }
707             
708                         my @values = defined $values ? @$values: ();
709                         ## Perform the checking
710                         while(@type_constraints) {
711                                 my $type_constraint = shift @type_constraints;
712                                 if(@values) {
713                                         my $value = shift @values;
714                                         unless($type_constraint->check($value)) {
715                         $_[2]->{message} = $type_constraint->get_message($value)
716                          if ref $_[2];
717                                                 return;
718                                         }                               
719                                 } else {
720                     ## Test if the TC supports null values
721                                         unless($type_constraint->check()) {
722                         $_[2]->{message} = $type_constraint->get_message('NULL')
723                          if ref $_[2];
724                                                 return;
725                                         }
726                                 }
727                         }
728                         ## Make sure there are no leftovers.
729                         if(@values) {
730                 if($overflow_handler) {
731                     return $overflow_handler->check([@values], $_[2]);
732                 } else {
733                     $_[2]->{message} = "More values than Type Constraints!"
734                      if ref $_[2];
735                     return;
736                 }
737                         } elsif(@type_constraints) {
738                 $_[2]->{message} =
739                  "Not enough values for all defined type constraints.  Remaining: ". join(', ',@type_constraints)
740                  if ref $_[2];
741                                 return;
742                         } else {
743                                 return 1;
744                         }
745                 }
746         )
747 );
748         
749 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
750         MooseX::Meta::TypeConstraint::Structured->new(
751                 name => "MooseX::Types::Structured::Dict",
752                 parent => find_type_constraint('HashRef'),
753                 constraint_generator=> sub { 
754                         ## Get the constraints and values to check
755             my ($type_constraints, $values) = @_;
756                         my @type_constraints = defined $type_constraints ?
757              @$type_constraints : ();
758             
759             my $overflow_handler;
760             if($type_constraints[-1] && blessed $type_constraints[-1]
761               && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
762                 $overflow_handler = pop @type_constraints;
763             } 
764             my (%type_constraints) = @type_constraints;
765                         my %values = defined $values ? %$values: ();
766                         ## Perform the checking
767                         while(%type_constraints) {
768                                 my($key, $type_constraint) = each %type_constraints;
769                                 delete $type_constraints{$key};
770                                 if(exists $values{$key}) {
771                                         my $value = $values{$key};
772                                         delete $values{$key};
773                                         unless($type_constraint->check($value)) {
774                         $_[2]->{message} = $type_constraint->get_message($value)
775                          if ref $_[2];
776                                                 return;
777                                         }
778                                 } else {
779                     ## Test to see if the TC supports null values
780                                         unless($type_constraint->check()) {
781                         $_[2]->{message} = $type_constraint->get_message('NULL')
782                          if ref $_[2];
783                                                 return;
784                                         }
785                                 }
786                         }
787                         ## Make sure there are no leftovers.
788                         if(%values) { 
789                 if($overflow_handler) {
790                     return $overflow_handler->check(+{%values});
791                 } else {
792                     $_[2]->{message} = "More values than Type Constraints!"
793                      if ref $_[2];
794                     return;
795                 }
796                         } elsif(%type_constraints) {
797                 $_[2]->{message} =
798                  "Not enough values for all defined type constraints.  Remaining: ". join(', ',values %values)
799                  if ref $_[2];
800                                 return;
801                         } else {
802                                 return 1;
803                         }
804                 },
805         )
806 );
807
808 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
809   MooseX::Meta::TypeConstraint::Structured->new(
810     name => "MooseX::Types::Structured::Map",
811     parent => find_type_constraint('HashRef'),
812     constraint_generator=> sub { 
813       ## Get the constraints and values to check
814       my ($type_constraints, $values) = @_;
815       my @constraints = defined $type_constraints ? @$type_constraints : ();
816             
817       Carp::confess( "too many args for Map type" ) if @constraints > 2;
818
819       my ($key_type, $value_type) = @constraints == 2 ? @constraints
820                                   : @constraints == 1 ? (undef, @constraints)
821                                   :                     ();
822
823       my %values = defined $values ? %$values: ();
824       ## Perform the checking
825       if ($value_type) {
826         for my $value (values %$values) {
827           unless ($value_type->check($value)) {
828             $_[2]->{message} = $value_type->get_message($value) if ref $_[2];
829             return;
830           }
831         }
832       }
833
834       if ($key_type) {
835         for my $key (keys %$values) {
836           unless ($key_type->check($key)) {
837             $_[2]->{message} = $key_type->get_message($key) if ref $_[2];
838             return;
839           }
840         }
841       }
842
843       return 1;
844     },
845   )
846 );
847
848 OPTIONAL: {
849     my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
850         name => 'MooseX::Types::Structured::Optional',
851         package_defined_in => __PACKAGE__,
852         parent => find_type_constraint('Item'),
853         constraint => sub { 1 },
854         constraint_generator => sub {
855             my ($type_parameter, @args) = @_;
856             my $check = $type_parameter->_compiled_type_constraint();
857             return sub {
858                 my (@args) = @_;
859                 ## Does the arg exist?  Something exists if it's a 'real' value
860                 ## or if it is set to undef.
861                 if(exists($args[0])) {
862                     ## If it exists, we need to validate it
863                     $check->($args[0]);
864                 } else {
865                     ## But it's is okay if the value doesn't exists
866                     return 1;
867                 }
868             }
869         }
870     );
871
872     Moose::Util::TypeConstraints::register_type_constraint($Optional);
873     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
874 }
875
876 sub slurpy ($) {
877         my ($tc) = @_;
878         return MooseX::Types::Structured::OverflowHandler->new(
879         type_constraint => $tc,
880     );
881 }
882
883 =head1 SEE ALSO
884
885 The following modules or resources may be of interest.
886
887 L<Moose>, L<MooseX::Types>, L<Moose::Meta::TypeConstraint>,
888 L<MooseX::Meta::TypeConstraint::Structured>
889
890 =head1 TODO
891
892 Here's a list of stuff I would be happy to get volunteers helping with:
893
894         * All POD examples need test cases in t/documentation/*.t
895         * Want to break out the examples section to a separate cookbook style POD.
896         * Want more examples and best practice / usage guidance for authors
897         * Need to clarify deep coercions, 
898
899 =head1 AUTHOR
900
901 John Napiorkowski <jjnapiork@cpan.org>
902
903 =head1 CONTRIBUTORS
904
905 The following people have contributed to this module and agree with the listed
906 Copyright & license information included below:
907
908     Florian Ragwitz, <rafl@debian.org>
909     Yuval Kogman, <nothingmuch@woobling.org>
910     Tomas Doran, <bobtfish@bobtfish.net>
911
912 =head1 COPYRIGHT & LICENSE
913
914 Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
915
916 This program is free software; you can redistribute it and/or modify it under
917 the same terms as Perl itself.
918
919 =cut
920         
921 1;