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