use Moose::Util::TypeConstraints;
use MooseX::Meta::TypeConstraint::Structured;
+use MooseX::Types::Structured::OverflowHandler;
use MooseX::Types -declare => [qw(Dict Tuple Optional)];
use Sub::Exporter -setup => { exports => [ qw(Dict Tuple Optional slurpy) ] };
+use Devel::PartialDump;
+use Scalar::Util qw(blessed);
-our $VERSION = '0.09';
+our $VERSION = '0.155555';
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
@$type_constraints : ();
my $overflow_handler;
- if(ref $type_constraints[-1] eq 'CODE') {
+ if($type_constraints[-1] && blessed $type_constraints[-1]
+ && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
$overflow_handler = pop @type_constraints;
}
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->check([@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;
@$type_constraints : ();
my $overflow_handler;
- if(ref $type_constraints[-1] eq 'CODE') {
+ if($type_constraints[-1] && blessed $type_constraints[-1]
+ && $type_constraints[-1]->isa('MooseX::Types::Structured::OverflowHandler')) {
$overflow_handler = pop @type_constraints;
}
my (%type_constraints) = @type_constraints;
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;
}
}
## Make sure there are no leftovers.
if(%values) {
if($overflow_handler) {
- return $overflow_handler->(+{%values});
+ return $overflow_handler->check(+{%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;
Moose::Util::TypeConstraints::add_parameterizable_type($Optional);
}
-sub slurpy($) {
- my $tc = shift @_;
- return sub {
- $tc->check(shift);
- };
+sub slurpy ($) {
+ my ($tc) = @_;
+ return MooseX::Types::Structured::OverflowHandler->new(
+ type_constraint => $tc,
+ );
}
=head1 SEE ALSO
Want to break out the examples section to a separate cookbook style POD.
Want more examples and best practice / usage guidance for authors
Need to clarify deep coercions,
-Need to clarify subtypes of subtypes.
=head1 AUTHOR
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
+
John Napiorkowski, C<< <jjnapiork@cpan.org> >>
+=head1 CONTRIBUTORS
+
+The Following people have contributed to this module:
+
+ Florian Ragwitz, C<< <rafl@debian.org> >>
+ Yuval Kogman, C<< <nothingmuch@woobling.org> >>
+
=head1 COPYRIGHT & LICENSE
+Copyright 2008-2009, John Napiorkowski <jjnapiork@cpan.org>
+
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.