Use the new TypeError class to return structured error objects topics/structured-errors
Sam Vilain [Wed, 17 Mar 2010 06:54:36 +0000 (19:54 +1300)]
lib/MooseX/Types/Structured.pm

index 31448c6..808985f 100644 (file)
@@ -6,6 +6,7 @@ use Moose::Util::TypeConstraints;
 use MooseX::Meta::TypeConstraint::Structured;
 use MooseX::Meta::TypeConstraint::Structured::Optional;
 use MooseX::Types::Structured::OverflowHandler;
+use MooseX::Types::Structured::TypeError;
 use MooseX::Types -declare => [qw(Dict Map Tuple Optional)];
 use Sub::Exporter -setup => [ qw(Dict Map Tuple Optional slurpy) ];
 use Devel::PartialDump;
@@ -745,23 +746,32 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
 
                        my @values = defined $values ? @$values: ();
                        ## Perform the checking
+                       my $slot = 0;
                        while(@type_constraints) {
                                my $type_constraint = shift @type_constraints;
                                if(@values) {
                                        my $value = shift @values;
                                        unless($type_constraint->check($value)) {
-                        $_[2]->{message} = $type_constraint->get_message($value)
+                        $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+                               constraint => $type_constraint,
+                               value => $value,
+                               index => $slot,
+                              )
                          if ref $_[2];
                                                return;
                                        }
                                } else {
                     ## Test if the TC supports null values
                     unless ($type_constraint->is_subtype_of($Optional)) {
-                        $_[2]->{message} = $type_constraint->get_message('NULL')
+                        $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+                               constraint => $type_constraint,
+                               index => $slot,
+                              )
                          if ref $_[2];
                                                return;
                                        }
                                }
+                               ++$slot;
                        }
                        ## Make sure there are no leftovers.
                        if(@values) {
@@ -809,14 +819,21 @@ Moose::Util::TypeConstraints::get_type_constraint_registry->add_type_constraint(
                                        my $value = $values{$key};
                                        delete $values{$key};
                                        unless($type_constraint->check($value)) {
-                        $_[2]->{message} = $type_constraint->get_message($value)
+                         $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+                               constraint => $type_constraint,
+                               index => $key,
+                               value => $value,
+                              )
                          if ref $_[2];
                                                return;
                                        }
                                } else {
                     ## Test to see if the TC supports null values
                     unless ($type_constraint->is_subtype_of($Optional)) {
-                        $_[2]->{message} = $type_constraint->get_message('NULL')
+                         $_[2]->{message} = MooseX::Types::Structured::TypeError->new(
+                               constraint => $type_constraint,
+                               index => $key,
+                              )
                          if ref $_[2];
                                                return;
                                        }