From: Jesse Luehrs <doy@tozt.net>
Date: Mon, 25 Apr 2011 17:48:26 +0000 (-0500)
Subject: refactor the default type constraint message logic a bit
X-Git-Tag: 2.0100~27
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92a88343044c49fa4ad70d9646dad11c706b9868;p=gitmo%2FMoose.git

refactor the default type constraint message logic a bit
---

diff --git a/lib/Moose/Meta/TypeConstraint.pm b/lib/Moose/Meta/TypeConstraint.pm
index 303b8fb..9d5e128 100644
--- a/lib/Moose/Meta/TypeConstraint.pm
+++ b/lib/Moose/Meta/TypeConstraint.pm
@@ -33,6 +33,30 @@ __PACKAGE__->meta->add_attribute('message'   => (
     accessor  => 'message',
     predicate => 'has_message'
 ));
+__PACKAGE__->meta->add_attribute('_default_message' => (
+    accessor  => '_default_message',
+));
+# can't make this a default because it has to close over the type name, and
+# cmop attributes don't have lazy
+my $_default_message_generator = sub {
+    my $name = shift;
+    sub {
+        my $value = shift;
+        # have to load it late like this, since it uses Moose itself
+        my $can_partialdump = try {
+            # versions prior to 0.14 had a potential infinite loop bug
+            Class::MOP::load_class('Devel::PartialDump', { -version => 0.14 });
+            1;
+        };
+        if ($can_partialdump) {
+            $value = Devel::PartialDump->new->dump($value);
+        }
+        else {
+            $value = (defined $value ? overload::StrVal($value) : 'undef');
+        }
+        return "Validation failed for '" . $name . "' with value $value";
+    }
+};
 __PACKAGE__->meta->add_attribute('coercion'   => (
     accessor  => 'coercion',
     predicate => 'has_coercion'
@@ -80,6 +104,8 @@ sub new {
     my $self  = $class->_new(%args);
     $self->compile_type_constraint()
         unless $self->_has_compiled_type_constraint;
+    $self->_default_message($_default_message_generator->($self->name))
+        unless $self->has_message;
     return $self;
 }
 
@@ -182,25 +208,9 @@ sub assert_valid {
 
 sub get_message {
     my ($self, $value) = @_;
-    if (my $msg = $self->message) {
-        local $_ = $value;
-        return $msg->($value);
-    }
-    else {
-        # have to load it late like this, since it uses Moose itself
-        my $can_partialdump = try {
-            # versions prior to 0.14 had a potential infinite loop bug
-            Class::MOP::load_class('Devel::PartialDump', { -version => 0.14 });
-            1;
-        };
-        if ($can_partialdump) {
-            $value = Devel::PartialDump->new->dump($value);
-        }
-        else {
-            $value = (defined $value ? overload::StrVal($value) : 'undef');
-        }
-        return "Validation failed for '" . $self->name . "' with value $value";
-    }
+    my $msg = $self->message || $self->_default_message;
+    local $_ = $value;
+    return $msg->($value);
 }
 
 ## type predicates ...
diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm
index 8e99e45..88ed2d6 100644
--- a/lib/Moose/Meta/TypeConstraint/Class.pm
+++ b/lib/Moose/Meta/TypeConstraint/Class.pm
@@ -33,7 +33,7 @@ sub new {
 
     $args{inlined} = $inliner;
 
-    my $self = $class->_new( \%args );
+    my $self = $class->SUPER::new( \%args );
 
     $self->compile_type_constraint();
 
diff --git a/lib/Moose/Meta/TypeConstraint/DuckType.pm b/lib/Moose/Meta/TypeConstraint/DuckType.pm
index 3b1a1c0..beab63f 100644
--- a/lib/Moose/Meta/TypeConstraint/DuckType.pm
+++ b/lib/Moose/Meta/TypeConstraint/DuckType.pm
@@ -43,7 +43,7 @@ sub new {
 
     $args{inlined} = $inliner;
 
-    my $self = $class->_new(\%args);
+    my $self = $class->SUPER::new(\%args);
 
     $self->compile_type_constraint()
         unless $self->_has_compiled_type_constraint;
diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm
index 2e19a57..fdafd39 100644
--- a/lib/Moose/Meta/TypeConstraint/Enum.pm
+++ b/lib/Moose/Meta/TypeConstraint/Enum.pm
@@ -57,7 +57,7 @@ sub new {
     $args{_inline_var_name} = $var_name;
     $args{inline_environment} = { '%' . $var_name => \%values };
 
-    my $self = $class->_new(\%args);
+    my $self = $class->SUPER::new(\%args);
 
     $self->compile_type_constraint()
         unless $self->_has_compiled_type_constraint;
diff --git a/lib/Moose/Meta/TypeConstraint/Role.pm b/lib/Moose/Meta/TypeConstraint/Role.pm
index a69e6cd..d1e6dbc 100644
--- a/lib/Moose/Meta/TypeConstraint/Role.pm
+++ b/lib/Moose/Meta/TypeConstraint/Role.pm
@@ -34,7 +34,7 @@ sub new {
 
     $args{inlined} = $inliner;
 
-    my $self = $class->_new( \%args );
+    my $self = $class->SUPER::new( \%args );
 
     $self->_create_hand_optimized_type_constraint;
     $self->compile_type_constraint();