use Carp 'confess';
use Scalar::Util 'blessed';
-our $VERSION = '0.09';
+our $VERSION = '0.11';
our $AUTHORITY = 'cpan:STEVAN';
__PACKAGE__->meta->add_attribute('name' => (reader => 'name'));
predicate => 'has_parent',
));
__PACKAGE__->meta->add_attribute('constraint' => (
- reader => 'constraint',
- writer => '_set_constraint',
+ reader => 'constraint',
+ writer => '_set_constraint',
+ default => sub { sub { 1 } }
));
__PACKAGE__->meta->add_attribute('message' => (
accessor => 'message',
}
sub coerce { ((shift)->coercion || confess "Cannot coerce without a type coercion")->coerce(@_) }
-sub check { $_[0]->_compiled_type_constraint->($_[1]) }
+sub check { $_[0]->_compiled_type_constraint->($_[1]) ? 1 : undef }
sub validate {
my ($self, $value) = @_;
if ($self->_compiled_type_constraint->($value)) {
return undef;
}
else {
- if ($self->has_message) {
- local $_ = $value;
- return $self->message->($value);
- }
- else {
- return "Validation failed for '" . $self->name . "' failed";
- }
+ $self->get_message($value);
}
}
+sub get_message {
+ my ($self, $value) = @_;
+ $value = (defined $value ? overload::StrVal($value) : 'undef');
+ if (my $msg = $self->message) {
+ local $_ = $value;
+ return $msg->($value);
+ }
+ else {
+ return "Validation failed for '" . $self->name . "' failed with value $value";
+ }
+}
+
## type predicates ...
sub is_a_type_of {
my $type_constraint = $self->hand_optimized_type_constraint;
- return sub {
- confess unless ref $type_constraint;
- return undef unless $type_constraint->($_[0]);
- return 1;
- };
+ confess unless ref $type_constraint;
+
+ return $type_constraint;
}
sub _compile_subtype {
# then we compile them to run without
# having to recurse as we did before
- return subname $self->name => sub {
- local $_ = $_[0];
+ return subname $self->name => sub {
+ local $_ = $_[0];
foreach my $parent (@parents) {
return undef unless $parent->($_[0]);
}
- return undef unless $check->($_[0]);
- 1;
- };
+ return undef unless $check->($_[0]);
+ 1;
+ };
}
sub _compile_type {
my ($self, $check) = @_;
- return subname $self->name => sub {
- local $_ = $_[0];
- return undef unless $check->($_[0]);
- 1;
- };
+ return subname $self->name => sub {
+ local $_ = $_[0];
+ return undef unless $check->($_[0]);
+ 1;
+ };
}
## other utils ...
=item B<message>
+=item B<get_message ($value)>
+
=item B<has_coercion>
=item B<coercion>
=head1 COPYRIGHT AND LICENSE
-Copyright 2006, 2007 by Infinity Interactive, Inc.
+Copyright 2006-2008 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>