X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMooseX%2FMeta%2FTypeConstraint%2FStructured.pm;h=d7b655b91718139837e5d014b9da28db7619e109;hb=d716430a1f595e7bd54039e440a0286102fc87f1;hp=b58c92eed2b5bae148e8ea092c0c7c9c532284ca;hpb=190a34ebaf957618baf301ad0574bfc21b2f76b1;p=gitmo%2FMooseX-Types-Structured.git

diff --git a/lib/MooseX/Meta/TypeConstraint/Structured.pm b/lib/MooseX/Meta/TypeConstraint/Structured.pm
index b58c92e..d7b655b 100644
--- a/lib/MooseX/Meta/TypeConstraint/Structured.pm
+++ b/lib/MooseX/Meta/TypeConstraint/Structured.pm
@@ -2,6 +2,7 @@ package ## Hide from PAUSE
  MooseX::Meta::TypeConstraint::Structured;
 
 use Moose;
+use Devel::PartialDump;
 use Moose::Util::TypeConstraints ();
 use MooseX::Meta::TypeCoercion::Structured;
 extends 'Moose::Meta::TypeConstraint';
@@ -70,6 +71,29 @@ around 'new' => sub {
     return $self;
 };
 
+=head2 validate
+
+Messing with validate so that we can support niced error messages.
+=cut
+
+override 'validate' => sub {
+    my ($self, @args) = @_;
+    my $message = bless {message=>undef}, 'MooseX::Types::Structured::Message';
+
+    if ($self->_compiled_type_constraint->(@args, $message)) {
+        ## Everything is good, no error message to return
+        return undef;
+    } else {
+        ## Whoops, need to figure out the right error message
+        my $args = Devel::PartialDump::dump(@args);
+        if(my $message = $message->{message}) {
+            return $self->get_message("$args, Internal Validation Error is: $message");
+        } else {
+            return $self->get_message($args);
+        }
+    }
+};
+
 =head2 generate_constraint_for ($type_constraints)
 
 Given some type constraints, use them to generate validation rules for an ref
@@ -80,9 +104,10 @@ of values (to be passed at check time)
 sub generate_constraint_for {
     my ($self, $type_constraints) = @_;
     return sub {
-        my (@args) = @_;
+        my $arg =  shift @_;
         my $constraint_generator = $self->constraint_generator;
-        return $constraint_generator->($type_constraints, @args);
+        my $result = $constraint_generator->($type_constraints, $arg, $_[0]);
+        return $result;
     };
 }
 
@@ -215,7 +240,19 @@ sub type_constraints_equals {
 
 =head2 get_message
 
-May want to override this to set a more useful error message
+Give you a better peek into what's causing the error.  For now we stringify the
+incoming deep value with L<Devel::PartialDump> and pass that on to either your
+custom error message or the default one.  In the future we'll try to provide a
+more complete stack trace of the actual offending elements
+
+=cut
+
+around 'get_message' => sub {
+    my ($get_message, $self, $value) = @_;
+    $value = Devel::PartialDump::dump($value)
+     if ref $value;
+    return $self->$get_message($value);
+};
 
 =head1 SEE ALSO
 
@@ -234,4 +271,4 @@ it under the same terms as Perl itself.
 
 =cut
 
-1;
\ No newline at end of file
+__PACKAGE__->meta->make_immutable;
\ No newline at end of file