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