X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=6063e4c21a8928e8f6332eb12814a2e6b379792d;hb=190a34ebaf957618baf301ad0574bfc21b2f76b1;hp=cb688e6426898d5e4453a2dabd4c7a1f70140e73;hpb=d87e8b740c6b3e267831dd27a1177bb4f74e6255;p=gitmo%2FMooseX-Types-Structured.git diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm index cb688e6..6063e4c 100644 --- a/lib/MooseX/Types/Structured.pm +++ b/lib/MooseX/Types/Structured.pm @@ -4,9 +4,9 @@ use 5.008; use Moose; use Moose::Util::TypeConstraints; use MooseX::Meta::TypeConstraint::Structured; -use MooseX::Types -declare => [qw(Dict Tuple)]; +use MooseX::Types -declare => [qw(Dict Tuple Optional)]; -our $VERSION = '0.05'; +our $VERSION = '0.06'; our $AUTHORITY = 'cpan:JJNAPIORK'; =head1 NAME @@ -21,16 +21,31 @@ The following is example usage for this module. use Moose; use MooseX::Types::Moose qw(Str Int); - use MooseX::Types::Structured qw(Dict Tuple); - - has name => (isa=>Dict[first_name=>Str, last_name=>Str]); + use MooseX::Types::Structured qw(Dict 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], + ], + ); Then you can instantiate this class with something like: - my $instance = MyApp::MyClass->new( + my $john = MyApp::MyClass->new( name => { - first_name=>'John', - last_name=>'Napiorkowski', + first=>'John', + middle=>'James' + last=>'Napiorkowski', + }, + ); + + my $vanessa = MyApp::MyClass->new( + name => { + first=>'Vanessa', + last=>'Li' }, ); @@ -39,7 +54,8 @@ But all of these would cause a constraint error for the 'name' attribute: MyApp::MyClass->new( name=>'John' ); MyApp::MyClass->new( name=>{first_name=>'John'} ); MyApp::MyClass->new( name=>{first_name=>'John', age=>39} ); - + MyApp::MyClass->new( name=>{first=>'Vanessa', middle=>[1,2], last=>'Li'} ); + Please see the test cases for more examples. =head1 DESCRIPTION @@ -215,6 +231,29 @@ 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 EXAMPLES Here are some additional example usage for structured types. All examples can @@ -260,10 +299,11 @@ 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 { + constraint_generator=> sub { ## Get the constraints and values to check - my @type_constraints = @{shift @_}; - my @values = @{shift @_}; + my ($type_constraints, $values) = @_; + my @type_constraints = defined $type_constraints ? @$type_constraints: (); + my @values = defined $values ? @$values: (); ## Perform the checking while(@type_constraints) { my $type_constraint = shift @type_constraints; @@ -273,7 +313,9 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( return; } } else { - return; + unless($type_constraint->check()) { + return; + } } } ## Make sure there are no leftovers. @@ -292,10 +334,11 @@ 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 { + constraint_generator=> sub { ## Get the constraints and values to check - my %type_constraints = @{shift @_}; - my %values = %{shift @_}; + my ($type_constraints, $values) = @_; + my %type_constraints = defined $type_constraints ? @$type_constraints: (); + my %values = defined $values ? %$values: (); ## Perform the checking while(%type_constraints) { my($key, $type_constraint) = each %type_constraints; @@ -306,12 +349,14 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( unless($type_constraint->check($value)) { return; } - } else { - return; + } else { + unless($type_constraint->check()) { + return; + } } } ## Make sure there are no leftovers. - if(%values) { + if(%values) { return; } elsif(%type_constraints) { return; @@ -322,6 +367,33 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( ) ); +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) = @_; + 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; + } + } + } + ); + + Moose::Util::TypeConstraints::register_type_constraint($Optional); + Moose::Util::TypeConstraints::add_parameterizable_type($Optional); +} + + =head1 SEE ALSO The following modules or resources may be of interest.