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);
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
)
);
+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(