From: Tokuhiro Matsuno <tokuhirom@gmail.com>
Date: Sat, 11 Apr 2009 16:28:47 +0000 (+0900)
Subject: added typeconstraint's customizable error message support.
X-Git-Tag: 0.21~2
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=29607c0291634fac077d6e1c75e1491ba455c010;p=gitmo%2FMouse.git

added typeconstraint's customizable error message support.
---

diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm
index 66110e6..851755d 100644
--- a/lib/Mouse/Meta/Attribute.pm
+++ b/lib/Mouse/Meta/Attribute.pm
@@ -236,9 +236,7 @@ sub verify_against_type_constraint {
 
 sub verify_type_constraint_error {
     my($self, $name, $value, $type) = @_;
-    $type = ref($type) eq 'ARRAY' ? join '|', map { $_->name } @{ $type } : $type->name;
-    my $display = defined($value) ? overload::StrVal($value) : 'undef';
-    Carp::confess("Attribute ($name) does not pass the type constraint because: Validation failed for \'$type\' failed with value $display");
+    Carp::confess("Attribute ($name) does not pass the type constraint because: " . $type->get_message($value));
 }
 
 sub coerce_constraint { ## my($self, $value) = @_;
diff --git a/lib/Mouse/Meta/TypeConstraint.pm b/lib/Mouse/Meta/TypeConstraint.pm
index 7b584bf..538e3b2 100644
--- a/lib/Mouse/Meta/TypeConstraint.pm
+++ b/lib/Mouse/Meta/TypeConstraint.pm
@@ -14,7 +14,11 @@ sub new {
         $check = $check->{_compiled_type_constraint};
     }
 
-    bless +{ name => $name, _compiled_type_constraint => $check }, $class;
+    bless +{
+        name                      => $name,
+        _compiled_type_constraint => $check,
+        message                   => $args{message}
+    }, $class;
 }
 
 sub name { shift->{name} }
@@ -24,6 +28,25 @@ sub check {
     $self->{_compiled_type_constraint}->(@_);
 }
 
+sub message {
+    return $_[0]->{message};
+}
+
+sub get_message {
+    my ($self, $value) = @_;
+    if ( my $msg = $self->message ) {
+        local $_ = $value;
+        return $msg->($value);
+    }
+    else {
+        $value = ( defined $value ? overload::StrVal($value) : 'undef' );
+        return
+            "Validation failed for '"
+          . $self->name
+          . "' failed with value $value";
+    }
+}
+
 1;
 __END__
 
diff --git a/lib/Mouse/Util/TypeConstraints.pm b/lib/Mouse/Util/TypeConstraints.pm
index cf03de9..4f77130 100644
--- a/lib/Mouse/Util/TypeConstraints.pm
+++ b/lib/Mouse/Util/TypeConstraints.pm
@@ -109,8 +109,8 @@ sub subtype {
     if ($TYPE{$name} && $TYPE_SOURCE{$name} ne $pkg) {
         Carp::croak "The type constraint '$name' has already been created in $TYPE_SOURCE{$name} and cannot be created again in $pkg";
     };
-    my $constraint = $conf{where};
-    my $as_constraint = find_or_create_isa_type_constraint($conf{as} || 'Any');
+    my $constraint = delete $conf{where};
+    my $as_constraint = find_or_create_isa_type_constraint(delete $conf{as} || 'Any');
 
     $TYPE_SOURCE{$name} = $pkg;
     $TYPE{$name} = Mouse::Meta::TypeConstraint->new(
@@ -126,6 +126,7 @@ sub subtype {
                 $as_constraint->check($_[0]);
             }
         ),
+        %conf
     );
 
     return $name;
diff --git a/t/039-subtype.t b/t/039-subtype.t
index 2894d1e..5c4d9e1 100644
--- a/t/039-subtype.t
+++ b/t/039-subtype.t
@@ -22,8 +22,5 @@ do {
 
 ok(My::Class->new(name => 'foo'));
 
-TODO: {
-    local $TODO = "message is not used";
-    throws_ok { My::Class->new(name => '') } qr/^Attribute \(name\) does not pass the type constraint because: The string is empty!/;
-};
+throws_ok { My::Class->new(name => '') } qr/^Attribute \(name\) does not pass the type constraint because: The string is empty!/;