From: Florian Ragwitz <rafl@debian.org>
Date: Thu, 4 Feb 2010 01:33:10 +0000 (+0100)
Subject: Merge branch 'useful_optional'
X-Git-Tag: 0.20~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Types-Structured.git;a=commitdiff_plain;h=f42bd4dcd811e77019c2fd2ad40aeb155924285b

Merge branch 'useful_optional'

* useful_optional:
  Properly delegate coercions for Optional[].
  Same Optional[] fix, but for Tuple this time.
  More failing tests for Tuple.
  Check if it's optional, not if it accepts undef.
  Add failing tests for Optional[].
  Less trailing whitespace.

Conflicts:
	lib/MooseX/Types/Structured.pm
---

f42bd4dcd811e77019c2fd2ad40aeb155924285b
diff --cc lib/MooseX/Types/Structured.pm
index e85f3c1,890f1f1..ecea251
--- a/lib/MooseX/Types/Structured.pm
+++ b/lib/MooseX/Types/Structured.pm
@@@ -4,9 -4,10 +4,10 @@@ 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);
  
@@@ -816,74 -832,6 +843,46 @@@ Moose::Util::TypeConstraints::get_type_
  	)
  );
  
 +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(