docs for Map
[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 Map[ $key_constraint, $value_constraint ]
504
505 This defines a HashRef based constraint in which both the keys and values are
506 required to meet certain constraints.  For example, to map hostnames to IP
507 addresses, you might say:
508
509   Map[ HostName, IPAddress ]
510
511 The type constraint would only be met if every key was a valid HostName and
512 every value was a valid IPAddress.
513
514 =head2 Optional[$constraint]
515
516 This is primarily a helper constraint for Dict and Tuple type constraints.  What
517 this allows is for you to assert that a given type constraint is allowed to be
518 null (but NOT undefined).  If the value is null, then the type constraint passes
519 but if the value is defined it must validate against the type constraint.  This
520 makes it easy to make a Dict where one or more of the keys doesn't have to exist
521 or a tuple where some of the values are not required.  For example:
522
523     subtype Name() => as Dict[
524         first=>Str,
525         last=>Str,
526         middle=>Optional[Str],
527     ];
528
529 Creates a constraint that validates against a hashref with the keys 'first' and
530 'last' being strings and required while an optional key 'middle' is must be a
531 string if it appears but doesn't have to appear.  So in this case both the
532 following are valid:
533
534     {first=>'John', middle=>'James', last=>'Napiorkowski'}
535     {first=>'Vanessa', last=>'Li'}
536
537 If you use the 'Maybe' type constraint instead, your values will also validate
538 against 'undef', which may be incorrect for you.
539
540 =head1 EXPORTABLE SUBROUTINES
541
542 This type library makes available for export the following subroutines
543
544 =head2 slurpy
545
546 Structured type constraints by their nature are closed; that is validation will
547 depend on an exact match between your structure definition and the arguments to
548 be checked.  Sometimes you might wish for a slightly looser amount of validation.
549 For example, you may wish to validate the first 3 elements of an array reference
550 and allow for an arbitrary number of additional elements.  At first thought you
551 might think you could do it this way:
552
553     #  I want to validate stuff like: [1,"hello", $obj, 2,3,4,5,6,...]
554     subtype AllowTailingArgs,
555      as Tuple[
556        Int,
557        Str,
558        Object,
559        ArrayRef[Int],
560      ];
561
562 However what this will actually validate are structures like this:
563
564     [10,"Hello", $obj, [11,12,13,...] ]; # Notice element 4 is an ArrayRef
565
566 In order to allow structured validation of, "and then some", arguments, you can
567 use the L</slurpy> method against a type constraint.  For example:
568
569     use MooseX::Types::Structured qw(Tuple slurpy);
570
571     subtype AllowTailingArgs,
572      as Tuple[
573        Int,
574        Str,
575        Object,
576        slurpy ArrayRef[Int],
577      ];
578
579 This will now work as expected, validating ArrayRef structures such as:
580
581     [1,"hello", $obj, 2,3,4,5,6,...]
582
583 A few caveats apply.  First, the slurpy type constraint must be the last one in
584 the list of type constraint parameters.  Second, the parent type of the slurpy
585 type constraint must match that of the containing type constraint.  That means
586 that a Tuple can allow a slurpy ArrayRef (or children of ArrayRefs, including
587 another Tuple) and a Dict can allow a slurpy HashRef (or children/subtypes of
588 HashRef, also including other Dict constraints).
589
590 Please note the the technical way this works 'under the hood' is that the
591 slurpy keyword transforms the target type constraint into a coderef.  Please do
592 not try to create your own custom coderefs; always use the slurpy method.  The
593 underlying technology may change in the future but the slurpy keyword will be
594 supported.
595
596 =head1 ERROR MESSAGES
597
598 Error reporting has been improved to return more useful debugging messages. Now
599 I will stringify the incoming check value with L<Devel::PartialDump> so that you
600 can see the actual structure that is tripping up validation.  Also, I report the
601 'internal' validation error, so that if a particular element inside the
602 Structured Type is failing validation, you will see that.  There's a limit to
603 how deep this internal reporting goes, but you shouldn't see any of the "failed
604 with ARRAY(XXXXXX)" that we got with earlier versions of this module.
605
606 This support is continuing to expand, so it's best to use these messages for
607 debugging purposes and not for creating messages that 'escape into the wild'
608 such as error messages sent to the user.
609
610 Please see the test '12-error.t' for a more lengthy example.  Your thoughts and
611 preferable tests or code patches very welcome!
612
613 =head1 EXAMPLES
614
615 Here are some additional example usage for structured types.  All examples can
616 be found also in the 't/examples.t' test.  Your contributions are also welcomed.
617
618 =head2 Normalize a HashRef
619
620 You need a hashref to conform to a canonical structure but are required accept a
621 bunch of different incoming structures.  You can normalize using the Dict type
622 constraint and coercions.  This example also shows structured types mixed which
623 other MooseX::Types libraries.
624
625     package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
626
627     use Moose;
628     use DateTime;
629
630     use MooseX::Types::Structured qw(Dict Tuple);
631     use MooseX::Types::DateTime qw(DateTime);
632     use MooseX::Types::Moose qw(Int Str Object);
633     use MooseX::Types -declare => [qw(Name Age Person)];
634
635     subtype Person,
636      as Dict[
637         name=>Str,
638         age=>Int,
639      ];
640
641     coerce Person,
642      from Dict[
643         first=>Str,
644         last=>Str,
645         years=>Int,
646      ], via { +{
647         name => "$_->{first} $_->{last}",
648         age => $_->{years},
649      }},
650      from Dict[
651         fullname=>Dict[
652                 last=>Str,
653                 first=>Str,
654         ],
655         dob=>DateTime,
656      ],
657      ## DateTime needs to be inside of single quotes here to disambiguate the
658      ## class package from the DataTime type constraint imported via the
659      ## line "use MooseX::Types::DateTime qw(DateTime);"
660      via { +{
661         name => "$_->{fullname}{first} $_->{fullname}{last}",
662         age => ($_->{dob} - 'DateTime'->now)->years,
663      }};
664
665     has person => (is=>'rw', isa=>Person, coerce=>1);
666
667 And now you can instantiate with all the following:
668
669     __PACKAGE__->new(
670         person=>{
671             name=>'John Napiorkowski',
672             age=>39,
673         },
674     );
675
676     __PACKAGE__->new(
677         person=>{
678             first=>'John',
679             last=>'Napiorkowski',
680             years=>39,
681         },
682     );
683
684     __PACKAGE__->new(
685         person=>{
686             fullname => {
687                 first=>'John',
688                 last=>'Napiorkowski'
689             },
690             dob => 'DateTime'->new(
691                 year=>1969,
692                 month=>2,
693                 day=>13
694             ),
695         },
696     );
697
698 This technique is a way to support various ways to instantiate your class in a
699 clean and declarative way.
700
701 =cut
702
703 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
704         MooseX::Meta::TypeConstraint::Structured->new(
705                 name => "MooseX::Types::Structured::Tuple" ,
706                 parent => find_type_constraint('ArrayRef'),
707                 constraint_generator=> sub {
708                         ## Get the constraints and values to check
709             my ($type_constraints, $values) = @_;
710                         my @type_constraints = defined $type_constraints ?
711              @$type_constraints : ();
712
713             my $overflow_handler;
714             if($type_constraints[-1] && blessed $type_constraints[-1]
715               && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
716                 $overflow_handler = pop @type_constraints;
717             }
718
719                         my @values = defined $values ? @$values: ();
720                         ## Perform the checking
721                         while(@type_constraints) {
722                                 my $type_constraint = shift @type_constraints;
723                                 if(@values) {
724                                         my $value = shift @values;
725                                         unless($type_constraint->check($value)) {
726                         $_[2]->{message} = $type_constraint->get_message($value)
727                          if ref $_[2];
728                                                 return;
729                                         }
730                                 } else {
731                     ## Test if the TC supports null values
732                                         unless($type_constraint->check()) {
733                         $_[2]->{message} = $type_constraint->get_message('NULL')
734                          if ref $_[2];
735                                                 return;
736                                         }
737                                 }
738                         }
739                         ## Make sure there are no leftovers.
740                         if(@values) {
741                 if($overflow_handler) {
742                     return $overflow_handler->check([@values], $_[2]);
743                 } else {
744                     $_[2]->{message} = "More values than Type Constraints!"
745                      if ref $_[2];
746                     return;
747                 }
748                         } elsif(@type_constraints) {
749                 $_[2]->{message} =
750                  "Not enough values for all defined type constraints.  Remaining: ". join(', ',@type_constraints)
751                  if ref $_[2];
752                                 return;
753                         } else {
754                                 return 1;
755                         }
756                 }
757         )
758 );
759
760 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
761         MooseX::Meta::TypeConstraint::Structured->new(
762                 name => "MooseX::Types::Structured::Dict",
763                 parent => find_type_constraint('HashRef'),
764                 constraint_generator=> sub {
765                         ## Get the constraints and values to check
766             my ($type_constraints, $values) = @_;
767                         my @type_constraints = defined $type_constraints ?
768              @$type_constraints : ();
769
770             my $overflow_handler;
771             if($type_constraints[-1] && blessed $type_constraints[-1]
772               && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
773                 $overflow_handler = pop @type_constraints;
774             }
775             my (%type_constraints) = @type_constraints;
776                         my %values = defined $values ? %$values: ();
777                         ## Perform the checking
778                         while(%type_constraints) {
779                                 my($key, $type_constraint) = each %type_constraints;
780                                 delete $type_constraints{$key};
781                                 if(exists $values{$key}) {
782                                         my $value = $values{$key};
783                                         delete $values{$key};
784                                         unless($type_constraint->check($value)) {
785                         $_[2]->{message} = $type_constraint->get_message($value)
786                          if ref $_[2];
787                                                 return;
788                                         }
789                                 } else {
790                     ## Test to see if the TC supports null values
791                                         unless($type_constraint->check()) {
792                         $_[2]->{message} = $type_constraint->get_message('NULL')
793                          if ref $_[2];
794                                                 return;
795                                         }
796                                 }
797                         }
798                         ## Make sure there are no leftovers.
799                         if(%values) {
800                 if($overflow_handler) {
801                     return $overflow_handler->check(+{%values});
802                 } else {
803                     $_[2]->{message} = "More values than Type Constraints!"
804                      if ref $_[2];
805                     return;
806                 }
807                         } elsif(%type_constraints) {
808                 $_[2]->{message} =
809                  "Not enough values for all defined type constraints.  Remaining: ". join(', ',values %values)
810                  if ref $_[2];
811                                 return;
812                         } else {
813                                 return 1;
814                         }
815                 },
816         )
817 );
818
819 Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
820   MooseX::Meta::TypeConstraint::Structured->new(
821     name => "MooseX::Types::Structured::Map",
822     parent => find_type_constraint('HashRef'),
823     constraint_generator=> sub {
824       ## Get the constraints and values to check
825       my ($type_constraints, $values) = @_;
826       my @constraints = defined $type_constraints ? @$type_constraints : ();
827
828       Carp::confess( "too many args for Map type" ) if @constraints > 2;
829
830       my ($key_type, $value_type) = @constraints == 2 ? @constraints
831                                   : @constraints == 1 ? (undef, @constraints)
832                                   :                     ();
833
834       my %values = defined $values ? %$values: ();
835       ## Perform the checking
836       if ($value_type) {
837         for my $value (values %$values) {
838           unless ($value_type->check($value)) {
839             $_[2]->{message} = $value_type->get_message($value) if ref $_[2];
840             return;
841           }
842         }
843       }
844
845       if ($key_type) {
846         for my $key (keys %$values) {
847           unless ($key_type->check($key)) {
848             $_[2]->{message} = $key_type->get_message($key) if ref $_[2];
849             return;
850           }
851         }
852       }
853
854       return 1;
855     },
856   )
857 );
858
859 OPTIONAL: {
860     my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
861         name => 'MooseX::Types::Structured::Optional',
862         package_defined_in => __PACKAGE__,
863         parent => find_type_constraint('Item'),
864         constraint => sub { 1 },
865         constraint_generator => sub {
866             my ($type_parameter, @args) = @_;
867             my $check = $type_parameter->_compiled_type_constraint();
868             return sub {
869                 my (@args) = @_;
870                 ## Does the arg exist?  Something exists if it's a 'real' value
871                 ## or if it is set to undef.
872                 if(exists($args[0])) {
873                     ## If it exists, we need to validate it
874                     $check->($args[0]);
875                 } else {
876                     ## But it's is okay if the value doesn't exists
877                     return 1;
878                 }
879             }
880         }
881     );
882
883     Moose::Util::TypeConstraints::register_type_constraint($Optional);
884     Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
885 }
886
887 sub slurpy ($) {
888         my ($tc) = @_;
889         return MooseX::Types::Structured::OverflowHandler->new(
890         type_constraint => $tc,
891     );
892 }
893
894 =head1 SEE ALSO
895
896 The following modules or resources may be of interest.
897
898 L<Moose>, L<MooseX::Types>, L<Moose::Meta::TypeConstraint>,
899 L<MooseX::Meta::TypeConstraint::Structured>
900
901 =head1 TODO
902
903 Here's a list of stuff I would be happy to get volunteers helping with:
904
905         * All POD examples need test cases in t/documentation/*.t
906         * Want to break out the examples section to a separate cookbook style POD.
907         * Want more examples and best practice / usage guidance for authors
908         * Need to clarify deep coercions,
909
910 =head1 AUTHOR
911
912 John Napiorkowski <jjnapiork@cpan.org>
913
914 =head1 CONTRIBUTORS
915
916 The following people have contributed to this module and agree with the listed
917 Copyright & license information included below:
918
919     Florian Ragwitz, <rafl@debian.org>
920     Yuval Kogman, <nothingmuch@woobling.org>
921     Tomas Doran, <bobtfish@bobtfish.net>
922
923 =head1 COPYRIGHT & LICENSE
924
925 Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
926
927 This program is free software; you can redistribute it and/or modify it under
928 the same terms as Perl itself.
929
930 =cut
931
932 1;