X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FTypes%2FStructured.pm;h=31448c61e76ae2a8322620a5f3a78002f2b40e12;hb=67eec8f705f693670aba8d2810e30fcf59191f44;hp=f5fb3461dcda8fba1b7eaec8fa92fe15a81e2317;hpb=b86402a09c4f8f81b5f685e340c96d2361c742de;p=gitmo%2FMooseX-Types-Structured.git diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm index f5fb346..31448c6 100644 --- a/lib/MooseX/Types/Structured.pm +++ b/lib/MooseX/Types/Structured.pm @@ -4,13 +4,14 @@ use 5.008; use Moose::Util::TypeConstraints; use MooseX::Meta::TypeConstraint::Structured; +use MooseX::Meta::TypeConstraint::Structured::Optional; use MooseX::Types::Structured::OverflowHandler; -use MooseX::Types -declare => [qw(Dict Tuple Optional)]; -use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] }; +use MooseX::Types -declare => [qw(Dict Map Tuple Optional)]; +use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ]; use Devel::PartialDump; use Scalar::Util qw(blessed); -our $VERSION = '0.19'; +our $VERSION = '0.20'; our $AUTHORITY = 'cpan:JJNAPIORK'; =head1 NAME @@ -127,7 +128,7 @@ 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 +familiar 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: @@ -500,6 +501,17 @@ hashref. For example: The keys in %constraints follow the same rules as @constraints in the above section. +=head2 Map[ $key_constraint, $value_constraint ] + +This defines a HashRef based constraint in which both the keys and values are +required to meet certain constraints. For example, to map hostnames to IP +addresses, you might say: + + Map[ HostName, IPAddress ] + +The type constraint would only be met if every key was a valid HostName and +every value was a valid IPAddress. + =head2 Optional[$constraint] This is primarily a helper constraint for Dict and Tuple type constraints. What @@ -689,7 +701,7 @@ clean and declarative way. =cut -my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new( +my $Optional = MooseX::Meta::TypeConstraint::Structured::Optional->new( name => 'MooseX::Types::Structured::Optional', package_defined_in => __PACKAGE__, parent => find_type_constraint('Item'), @@ -831,6 +843,46 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( ) ); +Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint( + MooseX::Meta::TypeConstraint::Structured->new( + name => "MooseX::Types::Structured::Map", + parent => find_type_constraint('HashRef'), + constraint_generator=> sub { + ## Get the constraints and values to check + my ($type_constraints, $values) = @_; + my @constraints = defined $type_constraints ? @$type_constraints : (); + + Carp::confess( "too many args for Map type" ) if @constraints > 2; + + my ($key_type, $value_type) = @constraints == 2 ? @constraints + : @constraints == 1 ? (undef, @constraints) + : (); + + my %values = defined $values ? %$values: (); + ## Perform the checking + if ($value_type) { + for my $value (values %$values) { + unless ($value_type->check($value)) { + $_[2]->{message} = $value_type->get_message($value) if ref $_[2]; + return; + } + } + } + + if ($key_type) { + for my $key (keys %$values) { + unless ($key_type->check($key)) { + $_[2]->{message} = $key_type->get_message($key) if ref $_[2]; + return; + } + } + } + + return 1; + }, + ) +); + sub slurpy ($) { my ($tc) = @_; return MooseX::Types::Structured::OverflowHandler->new(