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