package MooseX::Types::Structured;
-use MooseX::Types::Moose qw();
-use MooseX::Types -declare => [qw( Dict Tuple Optional )];
+use 5.008;
-our $VERSION = '0.01';
+use Moose::Util::TypeConstraints;
+use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Types::Structured::OverflowHandler;
+use MooseX::Types -declare => [qw(Dict Tuple Optional)];
+use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
+use Devel::PartialDump;
+use Scalar::Util qw(blessed);
+
+our $VERSION = '0.16';
our $AUTHORITY = 'cpan:JJNAPIORK';
=head1 NAME
-MooseX::Types::Structured; Structured Type Constraints for Moose
+MooseX::Types::Structured - Structured Type Constraints for Moose
=head1 SYNOPSIS
-The following is example usage for this module
-
- package MyApp::Types
- TBD
-
-=head1 DESCRIPTION
-
-What this application does, why I made it etc.
-
-=head1 TYPES
-
-This class defines the following types and subtypes.
-
-=cut
-
-
-=head1 SEE ALSO
-
-The following modules or resources may be of interest.
-
-L<Moose>, L<MooseX::TypeLibrary>, L<Moose::Meta::TypeConstraint>
+The following is example usage for this module.
+
+ package Person;
+
+ use Moose;
+ use MooseX::Types::Moose qw(Str Int HashRef);
+ use MooseX::Types::Structured qw(Dict Tuple Optional);
+
+ ## A name has a first and last part, but middle names are not required
+ has name => (
+ isa=>Dict[
+ first => Str,
+ last => Str,
+ middle => Optional[Str],
+ ],
+ );
+
+ ## description is a string field followed by a HashRef of tagged data.
+ has description => (
+ isa=>Tuple[
+ Str,
+ Optional[HashRef],
+ ],
+ );
-=head1 BUGS
+Then you can instantiate this class with something like:
+
+ my $john = Person->new(
+ name => {
+ first => 'John',
+ middle => 'James'
+ last => 'Napiorkowski',
+ },
+ description => [
+ 'A cool guy who loves Perl and Moose.', {
+ married_to => 'Vanessa Li',
+ born_in => 'USA',
+ };
+ ]
+ );
-No known or reported bugs.
+Or with:
-=head1 AUTHOR
+ my $vanessa = Person->new(
+ name => {
+ first => 'Vanessa',
+ last => 'Li'
+ },
+ description => ['A great student!'],
+ );
-John Napiorkowski, C<< <jjnapiork@cpan.org> >>
+But all of these would cause a constraint error for the 'name' attribute:
+
+ ## Value for 'name' not a HashRef
+ Person->new( name => 'John' );
+
+ ## Value for 'name' has incorrect hash key and missing required keys
+ Person->new( name => {
+ first_name => 'John'
+ });
+
+ ## Also incorrect keys
+ Person->new( name => {
+ first_name => 'John',
+ age => 39,
+ });
+
+ ## key 'middle' incorrect type, should be a Str not a ArrayRef
+ Person->new( name => {
+ first => 'Vanessa',
+ middle => [1,2],
+ last => 'Li',
+ });
+
+And these would cause a constraint error for the 'description' attribute:
+
+ ## Should be an ArrayRef
+ Person->new( description => 'Hello I am a String' );
+
+ ## First element must be a string not a HashRef.
+ Person->new (description => [{
+ tag1 => 'value1',
+ tag2 => 'value2'
+ }]);
+
+Please see the test cases for more examples.
-=head1 COPYRIGHT & LICENSE
+=head1 DESCRIPTION
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
+A structured type constraint is a standard container L<Moose> type constraint,
+such as an ArrayRef or HashRef, which has been enhanced to allow you to
+explicitly name all the allowed type constraints inside the structure. The
+generalized form is:
+
+ TypeConstraint[@TypeParameters or %TypeParameters]
+
+Where 'TypeParameters' is an array reference or hash references of
+L<Moose::Meta::TypeConstraint> objects.
+
+This type library enables structured type constraints. It is built on top of the
+L<MooseX::Types> library system, so you should review the documentation for that
+if you are not familiar with it.
+
+=head2 Comparing Parameterized types to Structured types
+
+Parameterized constraints are built into core Moose and you are probably already
+familar with the type constraints 'HashRef' and 'ArrayRef'. Structured types
+have similar functionality, so their syntax is likewise similar. For example,
+you could define a parameterized constraint like:
+
+ subtype ArrayOfInts,
+ as Arrayref[Int];
+
+which would constrain a value to something like [1,2,3,...] and so on. On the
+other hand, a structured type constraint explicitly names all it's allowed
+'internal' type parameter constraints. For the example:
+
+ subtype StringFollowedByInt,
+ as Tuple[Str,Int];
+
+would constrain it's value to things like ['hello', 111] but ['hello', 'world']
+would fail, as well as ['hello', 111, 'world'] and so on. Here's another
+example:
+
+ subtype StringIntOptionalHashRef,
+ as Tuple[
+ Str, Int,
+ Optional[HashRef]
+ ];
+
+This defines a type constraint that validates values like:
+
+ ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
+ ['World', 200];
+
+Notice that the last type constraint in the structure is optional. This is
+enabled via the helper Optional type constraint, which is a variation of the
+core Moose type constraint 'Maybe'. The main difference is that Optional type
+constraints are required to validate if they exist, while 'Maybe' permits
+undefined values. So the following example would not validate:
+
+ StringIntOptionalHashRef->validate(['Hello Undefined', 1000, undef]);
+
+Please note the subtle difference between undefined and null. If you wish to
+allow both null and undefined, you should use the core Moose 'Maybe' type
+constraint instead:
+
+ use MooseX::Types -declare [qw(StringIntMaybeHashRef)];
+ use MooseX::Types::Moose qw(Maybe);
+ use MooseX::Types::Structured qw(Tuple);
+
+ subtype StringIntMaybeHashRef,
+ as Tuple[
+ Str, Int, Maybe[HashRef]
+ ];
+
+This would validate the following:
+
+ ['Hello', 100, {key1 => 'value1', key2 => 'value2'}];
+ ['World', 200, undef];
+ ['World', 200];
+
+Structured constraints are not limited to arrays. You can define a structure
+against a HashRef with 'Dict' as in this example:
+
+ subtype FirstNameLastName,
+ as Dict[
+ firstname => Str,
+ lastname => Str,
+ ];
+
+This would constrain a HashRef to something like:
+
+ {firstname => 'Christopher', lastname= > 'Parsons'};
+
+but all the following would fail validation:
+
+ ## Incorrect keys
+ {first => 'Christopher', last => 'Parsons'};
+
+ ## Too many keys
+ {firstname => 'Christopher', lastname => 'Parsons', middlename => 'Allen'};
+
+ ## Not a HashRef
+ ['Christopher', 'Christopher'];
+
+These structures can be as simple or elaborate as you wish. You can even
+combine various structured, parameterized and simple constraints all together:
+
+ subtype Crazy,
+ as Tuple[
+ Int,
+ Dict[name=>Str, age=>Int],
+ ArrayRef[Int]
+ ];
+
+Which would match "[1, {name=>'John', age=>25},[10,11,12]]". Please notice how
+the type parameters can be visually arranged to your liking and to improve the
+clarity of your meaning. You don't need to run then altogether onto a single
+line.
+
+=head2 Alternatives
+
+You should exercise some care as to whether or not your complex structured
+constraints would be better off contained by a real object as in the following
+example:
+
+ package MyApp::MyStruct;
+ use Moose;
+
+ ## lazy way to make a bunch of attributes
+ has $_ for qw(full_name age_in_years);
+
+ package MyApp::MyClass;
+ use Moose;
+
+ has person => (isa => 'MyApp::MyStruct');
+
+ my $instance = MyApp::MyClass->new(
+ person=>MyApp::MyStruct->new(
+ full_name => 'John',
+ age_in_years => 39,
+ ),
+ );
+
+This method may take some additional time to setup but will give you more
+flexibility. However, structured constraints are highly compatible with this
+method, granting some interesting possibilities for coercion. Try:
+
+ package MyApp::MyClass;
+
+ use Moose;
+ use MyApp::MyStruct;
+
+ ## It's recommended your type declarations live in a separate class in order
+ ## to promote reusability and clarity. Inlined here for brevity.
+
+ use MooseX::Types::DateTime qw(DateTime);
+ use MooseX::Types -declare [qw(MyStruct)];
+ use MooseX::Types::Moose qw(Str Int);
+ use MooseX::Types::Structured qw(Dict);
+
+ ## Use class_type to create an ISA type constraint if your object doesn't
+ ## inherit from Moose::Object.
+ class_type 'MyApp::MyStruct';
+
+ ## Just a shorter version really.
+ subtype MyStruct,
+ as 'MyApp::MyStruct';
+
+ ## Add the coercions.
+ coerce MyStruct,
+ from Dict[
+ full_name=>Str,
+ age_in_years=>Int
+ ], via {
+ MyApp::MyStruct->new(%$_);
+ },
+ from Dict[
+ lastname=>Str,
+ firstname=>Str,
+ dob=>DateTime
+ ], via {
+ my $name = $_->{firstname} .' '. $_->{lastname};
+ my $age = DateTime->now - $_->{dob};
+
+ MyApp::MyStruct->new(
+ full_name=>$name,
+ age_in_years=>$age->years,
+ );
+ };
+
+ has person => (isa=>MyStruct);
+
+This would allow you to instantiate with something like:
+
+ my $obj = MyApp::MyClass->new( person => {
+ full_name=>'John Napiorkowski',
+ age_in_years=>39,
+ });
+
+Or even:
+
+ my $obj = MyApp::MyClass->new( person => {
+ lastname=>'John',
+ firstname=>'Napiorkowski',
+ dob=>DateTime->new(year=>1969),
+ });
+
+If you are not familiar with how coercions work, check out the L<Moose> cookbook
+entry L<Moose::Cookbook::Recipe5> for an explanation. The section L</Coercions>
+has additional examples and discussion.
+
+=head2 Subtyping a Structured type constraint
+
+You need to exercise some care when you try to subtype a structured type as in
+this example:
+
+ subtype Person,
+ as Dict[name => Str];
+
+ subtype FriendlyPerson,
+ as Person[
+ name => Str,
+ total_friends => Int,
+ ];
+
+This will actually work BUT you have to take care that the subtype has a
+structure that does not contradict the structure of it's parent. For now the
+above works, but I will clarify the syntax for this at a future point, so
+it's recommended to avoid (should not really be needed so much anyway). For
+now this is supported in an EXPERIMENTAL way. Your thoughts, test cases and
+patches are welcomed for discussion. If you find a good use for this, please
+let me know.
+
+=head2 Coercions
+
+Coercions currently work for 'one level' deep. That is you can do:
+
+ subtype Person,
+ as Dict[
+ name => Str,
+ age => Int
+ ];
+
+ subtype Fullname,
+ as Dict[
+ first => Str,
+ last => Str
+ ];
+
+ coerce Person,
+ ## Coerce an object of a particular class
+ from BlessedPersonObject, via {
+ +{
+ name=>$_->name,
+ age=>$_->age,
+ };
+ },
+
+ ## Coerce from [$name, $age]
+ from ArrayRef, via {
+ +{
+ name=>$_->[0],
+ age=>$_->[1],
+ },
+ },
+ ## Coerce from {fullname=>{first=>...,last=>...}, dob=>$DateTimeObject}
+ from Dict[fullname=>Fullname, dob=>DateTime], via {
+ my $age = $_->dob - DateTime->now;
+ my $firstn = $_->{fullname}->{first};
+ my $lastn = $_->{fullname}->{last}
+ +{
+ name => $_->{fullname}->{first} .' '. ,
+ age =>$age->years
+ }
+ };
+
+And that should just work as expected. However, if there are any 'inner'
+coercions, such as a coercion on 'Fullname' or on 'DateTime', that coercion
+won't currently get activated.
+
+Please see the test '07-coerce.t' for a more detailed example. Discussion on
+extending coercions to support this welcome on the Moose development channel or
+mailing list.
+
+=head2 Recursion
+
+Newer versions of L<MooseX::Types> support recursive type constraints. That is
+you can include a type constraint as a contained type constraint of itself. For
+example:
+
+ subtype Person,
+ as Dict[
+ name=>Str,
+ friends=>Optional[
+ ArrayRef[Person]
+ ],
+ ];
+
+This would declare a Person subtype that contains a name and an optional
+ArrayRef of Persons who are friends as in:
+
+ {
+ name => 'Mike',
+ friends => [
+ { name => 'John' },
+ { name => 'Vincent' },
+ {
+ name => 'Tracey',
+ friends => [
+ { name => 'Stephenie' },
+ { name => 'Ilya' },
+ ],
+ },
+ ],
+ };
+
+Please take care to make sure the recursion node is either Optional, or declare
+a Union with an non recursive option such as:
+
+ subtype Value
+ as Tuple[
+ Str,
+ Str|Tuple,
+ ];
+
+Which validates:
+
+ [
+ 'Hello', [
+ 'World', [
+ 'Is', [
+ 'Getting',
+ 'Old',
+ ],
+ ],
+ ],
+ ];
+
+Otherwise you will define a subtype thatis impossible to validate since it is
+infinitely recursive. For more information about defining recursive types,
+please see the documentation in L<MooseX::Types> and the test cases.
+
+=head1 TYPE CONSTRAINTS
+
+This type library defines the following constraints.
+
+=head2 Tuple[@constraints]
+
+This defines an ArrayRef based constraint which allows you to validate a specific
+list of contained constraints. For example:
+
+ Tuple[Int,Str]; ## Validates [1,'hello']
+ Tuple[Str|Object, Int]; ## Validates ['hello', 1] or [$object, 2]
+
+=head2 Dict[%constraints]
+
+This defines a HashRef based constraint which allowed you to validate a specific
+hashref. For example:
+
+ Dict[name=>Str, age=>Int]; ## Validates {name=>'John', age=>39}
+
+=head2 Optional[$constraint]
+
+This is primarily a helper constraint for Dict and Tuple type constraints. What
+this allows if for you to assert that a given type constraint is allowed to be
+null (but NOT undefined). If the value is null, then the type constraint passes
+but if the value is defined it must validate against the type constraint. This
+makes it easy to make a Dict where one or more of the keys doesn't have to exist
+or a tuple where some of the values are not required. For example:
+
+ subtype Name() => as Dict[
+ first=>Str,
+ last=>Str,
+ middle=>Optional[Str],
+ ];
+
+Creates a constraint that validates against a hashref with the keys 'first' and
+'last' being strings and required while an optional key 'middle' is must be a
+string if it appears but doesn't have to appear. So in this case both the
+following are valid:
+
+ {first=>'John', middle=>'James', last=>'Napiorkowski'}
+ {first=>'Vanessa', last=>'Li'}
+
+=head1 EXPORTABLE SUBROUTINES
+
+This type library makes available for export the following subroutines
+
+=head2 slurpy
+
+Structured type constraints by their nature are closed; that is validation will
+depend on an exact match between your structure definition and the arguments to
+be checked. Sometimes you might wish for a slightly looser amount of validation.
+For example, you may wish to validate the first 3 elements of an array reference
+and allow for an arbitrary number of additional elements. At first thought you
+might think you could do it this way:
+
+ # I want to validate stuff like: [1,"hello", $obj, 2,3,4,5,6,...]
+ subtype AllowTailingArgs,
+ as Tuple[
+ Int,
+ Str,
+ Object,
+ ArrayRef[Int],
+ ];
+
+However what this will actually validate are structures like this:
+
+ [10,"Hello", $obj, [11,12,13,...] ]; # Notice element 4 is an ArrayRef
+
+In order to allow structured validation of, "and then some", arguments, you can
+use the </slurpy> method against a type constraint. For example:
+
+ use MooseX::Types::Structured qw(Tuple slurpy);
+
+ subtype AllowTailingArgs,
+ as Tuple[
+ Int,
+ Str,
+ Object,
+ slurpy ArrayRef[Int],
+ ];
+
+This will now work as expected, validating ArrayRef structures such as:
+
+ [1,"hello", $obj, 2,3,4,5,6,...]
+
+A few caveats apply. First, the slurpy type constraint must be the last one in
+the list of type constraint parameters. Second, the parent type of the slurpy
+type constraint must match that of the containing type constraint. That means
+that a Tuple can allow a slurpy ArrayRef (or children of ArrayRefs, including
+another Tuple) and a Dict can allow a slurpy HashRef (or children/subtypes of
+HashRef, also including other Dict constraints).
+
+Please note the the technical way this works 'under the hood' is that the
+slurpy keywork transforms the target type constraint into a coderef. Please do
+not try to create your own custom coderefs; always use the slurpy method. The
+underlying technology may change in the future but the slurpy keyword will be
+supported.
+
+=head1 ERROR MESSAGES
+
+Error reporting has been improved to return more useful debugging messages. Now
+I will stringify the incoming check value with L<Devel::PartialDump> so that you
+can see the actual structure that is tripping up validation. Also, I report the
+'internal' validation error, so that if a particular element inside the
+Structured Type is failing validation, you will see that. There's a limit to
+how deep this internal reporting goes, but you shouldn't see any of the "failed
+with ARRAY(XXXXXX)" that we got with earlier versions of this module.
+
+This support is continuing to expand, so it's best to use these messages for
+debugging purposes and not for creating messages that 'escape into the wild'
+such as error messages sent to the user.
+
+Please see the test '12-error.t' for a more lengthy example. Your thoughts and
+preferable tests or code patches very welcome!
+
+=head1 EXAMPLES
+
+Here are some additional example usage for structured types. All examples can
+be found also in the 't/examples.t' test. Your contributions are also welcomed.
+
+=head2 Normalize a HashRef
+
+You need a hashref to conform to a canonical structure but are required accept a
+bunch of different incoming structures. You can normalize using the Dict type
+constraint and coercions. This example also shows structured types mixed which
+other MooseX::Types libraries.
+
+ package Test::MooseX::Meta::TypeConstraint::Structured::Examples::Normalize;
+
+ use Moose;
+ use DateTime;
+
+ use MooseX::Types::Structured qw(Dict Tuple);
+ use MooseX::Types::DateTime qw(DateTime);
+ use MooseX::Types::Moose qw(Int Str Object);
+ use MooseX::Types -declare => [qw(Name Age Person)];
+
+ subtype Person,
+ as Dict[
+ name=>Str,
+ age=>Int,
+ ];
+
+ coerce Person,
+ from Dict[
+ first=>Str,
+ last=>Str,
+ years=>Int,
+ ], via { +{
+ name => "$_->{first} $_->{last}",
+ age => $_->{years},
+ }},
+ from Dict[
+ fullname=>Dict[
+ last=>Str,
+ first=>Str,
+ ],
+ dob=>DateTime,
+ ],
+ ## DateTime needs to be inside of single quotes here to disambiguate the
+ ## class package from the DataTime type constraint imported via the
+ ## line "use MooseX::Types::DateTime qw(DateTime);"
+ via { +{
+ name => "$_->{fullname}{first} $_->{fullname}{last}",
+ age => ($_->{dob} - 'DateTime'->now)->years,
+ }};
+
+ has person => (is=>'rw', isa=>Person, coerce=>1);
+
+And now you can instantiate with all the following:
+
+ __PACKAGE__->new(
+ person=>{
+ name=>'John Napiorkowski',
+ age=>39,
+ },
+ );
+
+ __PACKAGE__->new(
+ person=>{
+ first=>'John',
+ last=>'Napiorkowski',
+ years=>39,
+ },
+ );
+
+ __PACKAGE__->new(
+ person=>{
+ fullname => {
+ first=>'John',
+ last=>'Napiorkowski'
+ },
+ dob => 'DateTime'->new(
+ year=>1969,
+ month=>2,
+ day=>13
+ ),
+ },
+ );
+
+This technique is a way to support various ways to instantiate your class in a
+clean and declarative way.
=cut
-1;
-
-
-
-
-
-
-
-
-class_type "DateTime";
-class_type "DateTime::Duration";
-class_type "DateTime::TimeZone";
-class_type "DateTime::Locale::root" => { name => "DateTime::Locale" };
-
-subtype DateTime, as 'DateTime';
-subtype Duration, as 'DateTime::Duration';
-subtype TimeZone, as 'DateTime::TimeZone';
-subtype Locale, as 'DateTime::Locale';
-
-subtype( Now,
- as Str,
- where { $_ eq 'now' },
- Moose::Util::TypeConstraints::optimize_as {
- no warnings 'uninitialized';
- !ref($_[0]) and $_[0] eq 'now';
- },
+Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
+ MooseX::Meta::TypeConstraint::Structured->new(
+ name => "MooseX::Types::Structured::Tuple" ,
+ parent => find_type_constraint('ArrayRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
+ my ($type_constraints, $values) = @_;
+ my @type_constraints = defined $type_constraints ?
+ @$type_constraints : ();
+
+ my $overflow_handler;
+ if($type_constraints[-1] && blessed $type_constraints[-1]
+ && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
+ $overflow_handler = pop @type_constraints;
+ }
+
+ my @values = defined $values ? @$values: ();
+ ## Perform the checking
+ while(@type_constraints) {
+ my $type_constraint = shift @type_constraints;
+ if(@values) {
+ my $value = shift @values;
+ unless($type_constraint->check($value)) {
+ $_[2]->{message} = $type_constraint->get_message($value)
+ if ref $_[2];
+ return;
+ }
+ } else {
+ ## Test if the TC supports null values
+ unless($type_constraint->check()) {
+ $_[2]->{message} = $type_constraint->get_message('NULL')
+ if ref $_[2];
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(@values) {
+ if($overflow_handler) {
+ return $overflow_handler->check([@values], $_[2]);
+ } else {
+ $_[2]->{message} = "More values than Type Constraints!"
+ if ref $_[2];
+ return;
+ }
+ } elsif(@type_constraints) {
+ $_[2]->{message} =
+ "Not enough values for all defined type constraints. Remaining: ". join(', ',@type_constraints)
+ if ref $_[2];
+ return;
+ } else {
+ return 1;
+ }
+ }
+ )
);
-
-our %coercions = (
- DateTime => [
- from Num, via { 'DateTime'->from_epoch( epoch => $_ ) },
- from HashRef, via { 'DateTime'->new( %$_ ) },
- from Now, via { 'DateTime'->now },
- ],
- "DateTime::Duration" => [
- from Num, via { DateTime::Duration->new( seconds => $_ ) },
- from HashRef, via { DateTime::Duration->new( %$_ ) },
- ],
- "DateTime::TimeZone" => [
- from Str, via { DateTime::TimeZone->new( name => $_ ) },
- ],
- "DateTime::Locale" => [
- from Moose::Util::TypeConstraints::find_or_create_isa_type_constraint("Locale::Maketext"),
- via { DateTime::Locale->load($_->language_tag) },
- from Str, via { DateTime::Locale->load($_) },
- ],
+
+Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
+ MooseX::Meta::TypeConstraint::Structured->new(
+ name => "MooseX::Types::Structured::Dict",
+ parent => find_type_constraint('HashRef'),
+ constraint_generator=> sub {
+ ## Get the constraints and values to check
+ my ($type_constraints, $values) = @_;
+ my @type_constraints = defined $type_constraints ?
+ @$type_constraints : ();
+
+ my $overflow_handler;
+ if($type_constraints[-1] && blessed $type_constraints[-1]
+ && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
+ $overflow_handler = pop @type_constraints;
+ }
+ my (%type_constraints) = @type_constraints;
+ my %values = defined $values ? %$values: ();
+ ## Perform the checking
+ while(%type_constraints) {
+ my($key, $type_constraint) = each %type_constraints;
+ delete $type_constraints{$key};
+ if(exists $values{$key}) {
+ my $value = $values{$key};
+ delete $values{$key};
+ unless($type_constraint->check($value)) {
+ $_[2]->{message} = $type_constraint->get_message($value)
+ if ref $_[2];
+ return;
+ }
+ } else {
+ ## Test to see if the TC supports null values
+ unless($type_constraint->check()) {
+ $_[2]->{message} = $type_constraint->get_message('NULL')
+ if ref $_[2];
+ return;
+ }
+ }
+ }
+ ## Make sure there are no leftovers.
+ if(%values) {
+ if($overflow_handler) {
+ return $overflow_handler->check(+{%values});
+ } else {
+ $_[2]->{message} = "More values than Type Constraints!"
+ if ref $_[2];
+ return;
+ }
+ } elsif(%type_constraints) {
+ $_[2]->{message} =
+ "Not enough values for all defined type constraints. Remaining: ". join(', ',values %values)
+ if ref $_[2];
+ return;
+ } else {
+ return 1;
+ }
+ },
+ )
);
-for my $type ( "DateTime", DateTime ) {
- coerce $type => @{ $coercions{DateTime} };
-}
-
-for my $type ( "DateTime::Duration", Duration ) {
- coerce $type => @{ $coercions{"DateTime::Duration"} };
-}
-
-for my $type ( "DateTime::TimeZone", TimeZone ) {
- coerce $type => @{ $coercions{"DateTime::TimeZone"} };
-}
-
-for my $type ( "DateTime::Locale", Locale ) {
- coerce $type => @{ $coercions{"DateTime::Locale"} };
-}
-
-__PACKAGE__
-
-__END__
-
-=pod
-
-=head1 NAME
-
-MooseX::Types::DateTime - L<DateTime> related constraints and coercions for
-Moose
-
-=head1 SYNOPSIS
-
-Export Example:
-
- use MooseX::Types::DateTime qw(TimeZone);
-
- has time_zone => (
- isa => TimeZone,
- is => "rw",
- coerce => 1,
+OPTIONAL: {
+ my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
+ name => 'MooseX::Types::Structured::Optional',
+ package_defined_in => __PACKAGE__,
+ parent => find_type_constraint('Item'),
+ constraint => sub { 1 },
+ constraint_generator => sub {
+ my ($type_parameter, @args) = @_;
+ my $check = $type_parameter->_compiled_type_constraint();
+ return sub {
+ my (@args) = @_;
+ ## Does the arg exist? Something exists if it's a 'real' value
+ ## or if it is set to undef.
+ if(exists($args[0])) {
+ ## If it exists, we need to validate it
+ $check->($args[0]);
+ } else {
+ ## But it's is okay if the value doesn't exists
+ return 1;
+ }
+ }
+ }
);
- Class->new( time_zone => "Africa/Timbuktu" );
-
-Namespaced Example:
-
- use MooseX::Types::DateTime;
+ Moose::Util::TypeConstraints::register_type_constraint($Optional);
+ Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
+}
- has time_zone => (
- isa => 'DateTime::TimeZone',
- is => "rw",
- coerce => 1,
+sub slurpy ($) {
+ my ($tc) = @_;
+ return MooseX::Types::Structured::OverflowHandler->new(
+ type_constraint => $tc,
);
+}
- Class->new( time_zone => "Africa/Timbuktu" );
-
-=head1 DESCRIPTION
-
-This module packages several L<Moose::Util::TypeConstraints> with coercions,
-designed to work with the L<DateTime> suite of objects.
-
-=head1 CONSTRAINTS
-
-=over 4
-
-=item L<DateTime>
-
-A class type for L<DateTime>.
-
-=over 4
-
-=item from C<Num>
-
-Uses L<DateTime/from_epoch>. Floating values will be used for subsecond
-percision, see L<DateTime> for details.
-
-=item from C<HashRef>
-
-Calls L<DateTime/new> with the hash entries as arguments.
-
-=back
-
-=item L<Duration>
-
-A class type for L<DateTime::Duration>
-
-=over 4
-
-=item from C<Num>
-
-Uses L<DateTime::Duration/new> and passes the number as the C<seconds> argument.
-
-Note that due to leap seconds, DST changes etc this may not do what you expect.
-For instance passing in C<86400> is not always equivalent to one day, although
-there are that many seconds in a day. See L<DateTime/"How Date Math is Done">
-for more details.
-
-=item from C<HashRef>
-
-Calls L<DateTime::Duration/new> with the hash entries as arguments.
-
-=back
-
-=item L<DateTime::Locale>
-
-A class type for L<DateTime::Locale::root> with the name L<DateTime::Locale>.
-
-=over 4
-
-=item from C<Str>
-
-The string is treated as a language tag (e.g. C<en> or C<he_IL>) and given to
-L<DateTime::Locale/load>.
-
-=item from L<Locale::Maktext>
-
-The C<Locale::Maketext/language_tag> attribute will be used with L<DateTime::Locale/load>.
-
-=item L<DateTime::TimeZone>
-
-A class type for L<DateTime::TimeZone>.
-
-=over 4
+=head1 SEE ALSO
-=item from C<Str>
+The following modules or resources may be of interest.
-Treated as a time zone name or offset. See L<DateTime::TimeZone/USAGE> for more
-details on the allowed values.
+L<Moose>, L<MooseX::Types>, L<Moose::Meta::TypeConstraint>,
+L<MooseX::Meta::TypeConstraint::Structured>
-Delegates to L<DateTime::TimeZone/new> with the string as the C<name> argument.
+=head1 TODO
-=back
+Here's a list of stuff I would be happy to get volunteers helping with:
-=head1 SEE ALSO
+All POD examples need test cases in t/documentation/*.t
+Want to break out the examples section to a separate cookbook style POD.
+Want more examples and best practice / usage guidance for authors
+Need to clarify deep coercions,
-L<MooseX::Types::DateTimeX>
+=head1 AUTHOR
-L<DateTime>, L<DateTimeX::Easy>
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
-=head1 VERSION CONTROL
+John Napiorkowski, C<< <jjnapiork@cpan.org> >>
-L<http://code2.0beta.co.uk/moose/svn/MooseX-Types-DateTime/trunk>. Ask on
-#moose for commit bits.
+=head1 CONTRIBUTORS
-=head1 AUTHOR
+The Following people have contributed to this module:
-Yuval Kogman E<lt>nothingmuch@woobling.orgE<gt>
+ Florian Ragwitz, C<< <rafl@debian.org> >>
+ Yuval Kogman, C<< <nothingmuch@woobling.org> >>
-John Napiorkowski E<lt>jjn1056 at yahoo.comE<gt>
+=head1 COPYRIGHT & LICENSE
-=head1 COPYRIGHT
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
- Copyright (c) 2008 Yuval Kogman. All rights reserved
- This program is free software; you can redistribute
- it and/or modify it under the same terms as Perl itself.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
=cut
+
+1;