add a map type
[gitmo/MooseX-Types-Structured.git] / lib / MooseX / Types / Structured.pm
index 6c007f7..10019af 100644 (file)
@@ -5,12 +5,12 @@ use 5.008;
 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 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.18';
+our $VERSION = '0.19';
 our $AUTHORITY = 'cpan:JJNAPIORK';
 
 =head1 NAME
@@ -132,7 +132,7 @@ have similar functionality, so their syntax is likewise similar. For example,
 you could define a parameterized constraint like:
 
     subtype ArrayOfInts,
-     as Arrayref[Int];
+     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
@@ -553,7 +553,7 @@ 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 the L</slurpy> method against a type constraint.  For example:
 
     use MooseX::Types::Structured qw(Tuple slurpy);
     
@@ -577,7 +577,7 @@ 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
+slurpy keyword 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.
@@ -805,6 +805,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;
+    },
+  )
+);
+
 OPTIONAL: {
     my $Optional = Moose::Meta::TypeConstraint::Parameterizable->new(
         name => 'MooseX::Types::Structured::Optional',
@@ -858,15 +898,16 @@ Here's a list of stuff I would be happy to get volunteers helping with:
 
 =head1 AUTHOR
 
-John Napiorkowski C<< <jjnapiork@cpan.org> >>
+John Napiorkowski <jjnapiork@cpan.org>
 
 =head1 CONTRIBUTORS
 
 The following people have contributed to this module and agree with the listed
 Copyright & license information included below:
 
-    Florian Ragwitz, C<< <rafl@debian.org> >>
-    Yuval Kogman, C<< <nothingmuch@woobling.org> >>
+    Florian Ragwitz, <rafl@debian.org>
+    Yuval Kogman, <nothingmuch@woobling.org>
+    Tomas Doran, <bobtfish@bobtfish.net>
 
 =head1 COPYRIGHT & LICENSE