X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FMeta%2FTypeConstraint.pm;h=538e3b288a6c45b1a82223783e36f8ca12653380;hb=74be9f760d045a0174d76e54de1c66d6b66454c4;hp=7b584bfc74e703bc3fc16b152de8ffe176aa8a86;hpb=684db121da77d6c63be5a58e33606907ca2aa4fb;p=gitmo%2FMouse.git 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__