return $self;
};
+=head2 validate
+
+Messing with validate so that we can support niced error messages.
+=cut
+
+override 'validate' => sub {
+ my ($self, @args) = @_;
+ my $compiled_type_constraint = $self->_compiled_type_constraint;
+ my $message = bless {message=>undef}, 'MooseX::Types::Structured::Message';
+ my $result = $compiled_type_constraint->(@args, $message);
+
+ if($result) {
+ return $result;
+ } else {
+ my $args = Devel::PartialDump::dump(@args);
+ if(my $message = $message->{message}) {
+ return $self->get_message("$args, Internal Validation Error is: $message");
+ } else {
+ return $self->get_message($args);
+ }
+ }
+};
+
=head2 generate_constraint_for ($type_constraints)
Given some type constraints, use them to generate validation rules for an ref
sub generate_constraint_for {
my ($self, $type_constraints) = @_;
return sub {
- my (@args) = @_;
+ my $arg = shift @_;
my $constraint_generator = $self->constraint_generator;
- return $constraint_generator->($type_constraints, @args);
+ my $result = $constraint_generator->($type_constraints, $arg, $_[0]);
+ return $result;
};
}
around 'get_message' => sub {
my ($get_message, $self, $value) = @_;
- my $new_value = Devel::PartialDump::dump($value);
- return $self->$get_message($new_value);
+ $value = Devel::PartialDump::dump($value)
+ if ref $value;
+ return $self->$get_message($value);
};
=head1 SEE ALSO
use MooseX::Meta::TypeConstraint::Structured;
use MooseX::Types -declare => [qw(Dict Tuple Optional)];
use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
+use Devel::PartialDump;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
our $AUTHORITY = 'cpan:JJNAPIORK';
=head1 NAME
=head2 slurpy
Structured type constraints by their nature are closed; that is validation will
-depend and an exact match between your structure definition and the arguments to
+depend on an exact match between your structure definition and the arguments to
be checked. Sometimes you might wish for a slightly looser amount of validation.
For example, you may wish to validate the first 3 elements of an array reference
and allow for an arbitrary number of additional elements. At first thought you
underlying technology may change in the future but the slurpy keyword will be
supported.
+=head1 ERROR MESSAGES
+
+Error reporting has been improved to return more useful debugging messages. Now
+I will stringify the incoming check value with L<Devel::PartialDump> so that you
+can see the actual structure that is tripping up validation. Also, I report the
+'internal' validation error, so that if a particular element inside the
+Structured Type is failing validation, you will see that. There's a limit to
+how deep this internal reporting goes, but you shouldn't see any of the "failed
+with ARRAY(XXXXXX)" that we got with earlier versions of this module.
+
+This support is continuing to expand, so it's best to use these messages for
+debugging purposes and not for creating messages that 'escape into the wild'
+such as error messages sent to the user.
+
+Please see the test '12-error.t' for a more lengthy example. Your thoughts and
+preferable tests or code patches very welcome!
+
=head1 EXAMPLES
Here are some additional example usage for structured types. All examples can
And now you can instantiate with all the following:
__PACKAGE__->new(
- name=>'John Napiorkowski',
- age=>39,
+ person=>{
+ name=>'John Napiorkowski',
+ age=>39,
+ },
);
__PACKAGE__->new(
- first=>'John',
- last=>'Napiorkowski',
- years=>39,
+ person=>{
+ first=>'John',
+ last=>'Napiorkowski',
+ years=>39,
+ },
);
__PACKAGE__->new(
- fullname => {
- first=>'John',
- last=>'Napiorkowski'
+ person=>{
+ fullname => {
+ first=>'John',
+ last=>'Napiorkowski'
+ },
+ dob => 'DateTime'->new(
+ year=>1969,
+ month=>2,
+ day=>13
+ ),
},
- dob => 'DateTime'->new(
- year=>1969,
- month=>2,
- day=>13
- ),
);
This technique is a way to support various ways to instantiate your class in a
if(@values) {
my $value = shift @values;
unless($type_constraint->check($value)) {
+ $_[2]->{message} = $type_constraint->get_message($value)
+ if ref $_[2];
return;
}
} else {
## Test if the TC supports null values
unless($type_constraint->check()) {
+ $_[2]->{message} = $type_constraint->get_message('NULL')
+ if ref $_[2];
return;
}
}
## Make sure there are no leftovers.
if(@values) {
if($overflow_handler) {
- return $overflow_handler->([@values]);
+ return $overflow_handler->([@values], $_[2]);
} else {
+ $_[2]->{message} = "More values than Type Constraints!"
+ if ref $_[2];
return;
}
} elsif(@type_constraints) {
- warn "I failed due to left over TC";
+ $_[2]->{message} =
+ "Not enough values for all defined type constraints. Remaining: ". join(', ',@type_constraints)
+ if ref $_[2];
return;
} else {
return 1;
my $value = $values{$key};
delete $values{$key};
unless($type_constraint->check($value)) {
+ $_[2]->{message} = $type_constraint->get_message($value)
+ if ref $_[2];
return;
}
} else {
## Test to see if the TC supports null values
unless($type_constraint->check()) {
+ $_[2]->{message} = $type_constraint->get_message('NULL')
+ if ref $_[2];
return;
}
}
if($overflow_handler) {
return $overflow_handler->(+{%values});
} else {
+ $_[2]->{message} = "More values than Type Constraints!"
+ if ref $_[2];
return;
}
} elsif(%type_constraints) {
+ $_[2]->{message} =
+ "Not enough values for all defined type constraints. Remaining: ". join(', ',values %values)
+ if ref $_[2];
return;
} else {
return 1;
BEGIN {
use strict;
use warnings;
- use Test::More tests=>4;
+ use Test::More tests=>24;
}
use Moose::Util::TypeConstraints;
-use MooseX::Types::Structured qw(Dict Tuple);
+use MooseX::Types::Structured qw(Dict Tuple Optional);
use MooseX::Types::Moose qw(Int Str ArrayRef HashRef);
# Create some TCs from which errors will be generated
+
my $simple_tuple = subtype 'simple_tuple', as Tuple[Int,Str];
my $simple_dict = subtype 'simple_dict', as Dict[name=>Str,age=>Int];
-# We probably need more stuff here...
+# Make sure the constraints we made validate as expected
+
ok $simple_tuple->check([1,'hello']), "simple_tuple validates: 1,'hello'";
ok !$simple_tuple->check(['hello',1]), "simple_tuple fails: 'hello',1";
-like $simple_tuple->validate(['hello',1]), qr/"hello", 1/, 'got expected valiate message';
-like $simple_dict->validate(['hello',1]), qr/"hello", 1/, 'got expected valiate message';
+ok $simple_dict->check({name=>'Vanessa',age=>34}), "simple_dict validates: {name=>'Vanessa',age=>34}";
+ok !$simple_dict->check({name=>$simple_dict,age=>'hello'}), "simple_dict fails: {name=>Object, age=>String}";
+
+## Let's check all the expected validation errors for tuple
+
+like $simple_tuple->validate({a=>1,b=>2}),
+ qr/Validation failed for 'simple_tuple' failed with value { a => 1, b => 2 }/,
+ 'Wrong basic type';
+
+like $simple_tuple->validate(['a','b']),
+ qr/failed for 'simple_tuple' failed with value \[ "a", "b" \]/,
+ 'Correctly failed due to "a" not an Int';
+
+like $simple_tuple->validate([1,$simple_tuple]),
+ qr/Validation failed for 'simple_tuple' failed with value \[ 1, MooseX::Meta::TypeConstraint::Structured/,
+ 'Correctly failed due to object not a Str';
+
+like $simple_tuple->validate([1]),
+ qr/Validation failed for 'Str' failed with value NULL/,
+ 'Not enought values';
+
+like $simple_tuple->validate([1,'hello','too many']),
+ qr/More values than Type Constraints!/,
+ 'Too Many values';
+
+## And the same thing for dicts [name=>Str,age=>Int]
+
+like $simple_dict->validate([1,2]),
+ qr/ failed with value \[ 1, 2 \]/,
+ 'Wrong basic type';
+
+like $simple_dict->validate({name=>'John',age=>'a'}),
+ qr/failed for 'Int' failed with value a/,
+ 'Correctly failed due to age not an Int';
+
+like $simple_dict->validate({name=>$simple_dict,age=>1}),
+ qr/failed with value { age => 1, name => MooseX:/,
+ 'Correctly failed due to object not a Str';
+
+like $simple_dict->validate({name=>'John'}),
+ qr/failed for 'Int' failed with value NULL/,
+ 'Not enought values';
+
+like $simple_dict->validate({name=>'Vincent', age=>15,extra=>'morethanIneed'}),
+ qr/More values than Type Constraints!/,
+ 'Too Many values';
+
+ ## TODO some with Optional (or Maybe) and slurpy
+
+ my $optional_tuple = subtype 'optional_tuple', as Tuple[Int,Optional[Str]];
+ my $optional_dict = subtype 'optional_dict', as Dict[name=>Str,age=>Optional[Int]];
+
+ like $optional_tuple->validate({a=>1,b=>2}),
+ qr/Validation failed for 'optional_tuple' failed with value { a => 1, b => 2 }/,
+ 'Wrong basic type';
+
+like $optional_tuple->validate(['a','b']),
+ qr/failed for 'Int' failed with value a/,
+ 'Correctly failed due to "a" not an Int';
+
+like $optional_tuple->validate([1,$simple_tuple]),
+ qr/failed for 'MooseX::Types::Structured::Optional\[Str\]' failed with value MooseX/,
+ 'Correctly failed due to object not a Str';
+
+like $optional_tuple->validate([1,'hello','too many']),
+ qr/More values than Type Constraints!/,
+ 'Too Many values';
+
+like $optional_dict->validate([1,2]),
+ qr/ failed with value \[ 1, 2 \]/,
+ 'Wrong basic type';
+
+like $optional_dict->validate({name=>'John',age=>'a'}),
+ qr/Validation failed for 'MooseX::Types::Structured::Optional\[Int\]' failed with value a/,
+ 'Correctly failed due to age not an Int';
+
+like $optional_dict->validate({name=>$simple_dict,age=>1}),
+ qr/failed with value { age => 1, name => MooseX:/,
+ 'Correctly failed due to object not a Str';
+
+like $optional_dict->validate({name=>'Vincent', age=>15,extra=>'morethanIneed'}),
+ qr/More values than Type Constraints!/,
+ 'Too Many values';
+
+## Deeper constraints
+my $deep_tuple = subtype 'deep_tuple',
+ as Tuple[
+ Int,
+ HashRef,
+ Dict[
+ name=>Str,
+ age=>Int,
+ ],
+ ];
+
+ok $deep_tuple->check([1,{a=>2},{name=>'Vincent',age=>15}]),
+ 'Good Constraint';
+
+like $deep_tuple->validate([1,{a=>2},{name=>'Vincent',age=>'Hello'}]),
+ qr/Error is: Validation failed for 'MooseX::Types::Structured::Dict\[name,Str,age,Int\]'/,
+ 'Example deeper error';
projects / gitmo/MooseX-Types-Structured.git / commitdiff