From: Ricardo Signes <rjbs@cpan.org>
Date: Mon, 25 Jan 2010 23:15:52 +0000 (-0500)
Subject: add a map type
X-Git-Tag: 0.20~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=678b40647bd8df9296aa09ee25212d1f75f8696c

add a map type
---

diff --git a/lib/MooseX/Types/Structured.pm b/lib/MooseX/Types/Structured.pm
index 998bee9..10019af 100644
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@ -5,8 +5,8 @@ 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);
 
@@ -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',
diff --git a/t/04-map.t b/t/04-map.t
new file mode 100644
index 0000000..b976b1a
--- /dev/null
+++ b/t/04-map.t
@@ -0,0 +1,22 @@
+use strict;
+use warnings;
+use Test::More;
+
+use MooseX::Types::Moose qw(Int Num);
+use MooseX::Types::Structured qw(Map);
+use Try::Tiny;
+
+my $type = Map[ Int, Num ];
+
+ok($type->assert_valid({ 10 => 10.5 }), "simple Int -> Num mapping");
+
+eval { $type->assert_valid({ 10.5 => 10.5 }) };
+like($@, qr{value 10\.5}, "non-Int causes rejection on key");
+
+eval { $type->assert_valid({ 10 => "ten and a half" }) };
+like("$@", qr{value ten and a half}, "non-Num value causes rejection on value");
+
+ok($type->assert_valid({ }), "empty hashref is a valid mapping of any sort");
+
+done_testing;
+