[Moose-commits] r7879 - in MooseX-Types-Dependent/trunk: lib/MooseX/Meta/TypeConstraint t

[jnapiorkowski at code2.0beta.co.uk]

Author: jnapiorkowski
Date: 2009-03-31 20:11:50 -0700 (Tue, 31 Mar 2009)
New Revision: 7879

Modified:
   MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
   MooseX-Types-Dependent/trunk/t/02-depending.t
Log:
starting on the error messaging problem;


Modified: MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm
===================================================================
--- MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm	2009-03-30 18:09:35 UTC (rev 7878)
+++ MooseX-Types-Dependent/trunk/lib/MooseX/Meta/TypeConstraint/Dependent.pm	2009-04-01 03:11:50 UTC (rev 7879)
@@ -32,7 +32,8 @@
     isa=>'Object',
     predicate=>'has_dependent_type_constraint',
     handles=>{
-        check_dependent=>'check',  
+        check_dependent=>'check',
+        get_message_dependent=>'get_message',
     },
 );
 
@@ -107,6 +108,35 @@
     return $self;
 };
 
+=head2 validate
+
+We intercept validate in order to custom process the message
+
+
+=cut
+
+around 'check' => sub {
+    my ($check, $self, @args) = @_;
+    my ($result, $message) = $self->_compiled_type_constraint->(@args);
+    warn $result;
+    return $result;
+};
+
+around 'validate' => sub {
+    my ($validate, $self, @args) = @_;
+    my ($result, $message) = $self->_compiled_type_constraint->(@args);
+    
+    if($result) {
+        return $result;
+    } else {
+        if(defined $message) {
+            return "Inner: $message";
+        } else { warn '......................';
+            return $self->get_message(@args);
+        }
+    }
+};
+
 =head2 generate_constraint_for ($type_constraints)
 
 Given some type constraints, use them to generate validation rules for an ref
@@ -117,12 +147,12 @@
 sub generate_constraint_for {
     my ($self, $callback) = @_;
     return sub {   
-        my ($dependent_pair) = @_;
+        my $dependent_pair = shift @_;
         my ($dependent, $constraining) = @$dependent_pair;
         
         ## First need to test the bits
         unless($self->check_dependent($dependent)) {
-            return;
+            return (undef, 'bbbbbb');
         }
     
         unless($self->check_constraining($constraining)) {

Modified: MooseX-Types-Dependent/trunk/t/02-depending.t
===================================================================
--- MooseX-Types-Dependent/trunk/t/02-depending.t	2009-03-30 18:09:35 UTC (rev 7878)
+++ MooseX-Types-Dependent/trunk/t/02-depending.t	2009-04-01 03:11:50 UTC (rev 7879)
@@ -85,5 +85,9 @@
     ok !UniqueInt2->check([10,[1,10,15]]), 'not unique in set';
     ok !UniqueInt2->check([2,[3..6]]), 'FAIL dependent is too small';
     ok UniqueInt2->check([3,[100..110]]), 'PASS unique in set';
-    ok UniqueInt2->check([4,[100..110]]), 'PASS unique in set';	
+    ok UniqueInt2->check([4,[100..110]]), 'PASS unique in set';
+
+	## Basic error messages.  TODO should be it's own test
+	
+	warn UniqueInt2->validate(['a',[1,2,3]]);
 }