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);
)
);
+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;
+ },
+ )
+);
+
- 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;
- }
- }
- }
- );
-
- Moose::Util::TypeConstraints::register_type_constraint($Optional);
- Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
- }
-
sub slurpy ($) {
my ($tc) = @_;
return MooseX::Types::Structured::OverflowHandler->new(