[Moose-commits] r7470 - in MooseX-Params-Validate/trunk:
lib/MooseX/Params t
autarch at code2.0beta.co.uk
autarch at code2.0beta.co.uk
Sun Feb 1 16:16:51 GMT 2009
Author: autarch
Date: 2009-02-01 08:16:51 -0800 (Sun, 01 Feb 2009)
New Revision: 7470
Added:
MooseX-Params-Validate/trunk/t/008_positional.t
Modified:
MooseX-Params-Validate/trunk/lib/MooseX/Params/Validate.pm
Log:
Added pos_validated_list
Doc updates
Pass called param to validate_with that represents the sub for which
we're doing validation, makes much better errors messages
Modified: MooseX-Params-Validate/trunk/lib/MooseX/Params/Validate.pm
===================================================================
--- MooseX-Params-Validate/trunk/lib/MooseX/Params/Validate.pm 2009-02-01 15:42:31 UTC (rev 7469)
+++ MooseX-Params-Validate/trunk/lib/MooseX/Params/Validate.pm 2009-02-01 16:16:51 UTC (rev 7470)
@@ -9,9 +9,11 @@
use Moose::Util::TypeConstraints qw( find_type_constraint class_type role_type );
use Params::Validate ();
use Sub::Exporter -setup => {
- exports => [ qw( validated_hash validated_list validate validatep ) ],
- groups => {
- default => [qw( validated_hash validated_list )],
+ exports => [
+ qw( validated_hash validated_list pos_validated_list validate validatep )
+ ],
+ groups => {
+ default => [qw( validated_hash validated_list pos_validated_list )],
deprecated => [qw( validate validatep )],
},
};
@@ -53,7 +55,8 @@
%args = Params::Validate::validate_with(
params => \%args,
- spec => \%spec
+ spec => \%spec,
+ called => _caller_name(),
);
return ( ( $instance ? $instance : () ), %args );
@@ -99,7 +102,8 @@
%args = Params::Validate::validate_with(
params => \%args,
- spec => \%spec
+ spec => \%spec,
+ called => _caller_name(),
);
return (
@@ -110,6 +114,48 @@
*validatep = \&validated_list;
+sub pos_validated_list {
+ my $args = shift;
+
+ my @spec;
+ push @spec, shift while ref $_[0];
+
+ my %extra = @_;
+
+ my $cache_key = _cache_key( \%extra );
+
+ my @pv_spec;
+ if ( exists $CACHED_SPECS{$cache_key} ) {
+ ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
+ || confess
+ "I was expecting an ARRAY-ref in the cached $cache_key parameter"
+ . " spec, you are doing something funky, stop it!";
+ @pv_spec = @{ $CACHED_SPECS{$cache_key} };
+ }
+ else {
+ my $should_cache = exists $extra{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
+
+ # prepare the parameters ...
+ @pv_spec = map { _convert_to_param_validate_spec($_) } @spec;
+
+ $CACHED_SPECS{$cache_key} = \@pv_spec
+ if $should_cache;
+ }
+
+ my @args = @{$args};
+
+ $args[$_] = $pv_spec[$_]{constraint}->coerce( $args[$_] )
+ for grep { $pv_spec[$_]{coerce} } 0 .. $#pv_spec;
+
+ @args = Params::Validate::validate_with(
+ params => \@args,
+ spec => \@pv_spec,
+ called => _caller_name(),
+ );
+
+ return @args;
+}
+
sub _cache_key {
my $spec = shift;
@@ -117,7 +163,7 @@
return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
}
else {
- return ( caller(2) )[3];
+ return _caller_name(1);
}
}
@@ -182,6 +228,12 @@
return \%pv_spec;
}
+sub _caller_name {
+ my $depth = shift || 0;
+
+ return join '::', ( caller( 2 + $depth ) )[0, 3];
+}
+
1;
__END__
@@ -223,8 +275,8 @@
to Moose. This is just one of many developing options, it should not
be considered the "official" one by any means though.
-This is an early release of this module, and many things will likely
-change and get added, so watch out :)
+You might also want to explore C<MooseX::Method::Signatures> and
+C<MooseX::Declare>
=head1 CAVEATS
@@ -294,11 +346,53 @@
}
We capture the order in which you defined the parameters and then
-return them as positionals in the same order. If a param is marked
-optional and not included, then it will be set to C<undef>.
+return them as a list in the same order. If a param is marked optional
+and not included, then it will be set to C<undef>.
+Like C<validated_hash>, if it spots an object instance as the first
+parameter of C<@_>, it will handle it appropriately, returning it as
+the first argument.
+
This function is also available under its old name, C<validatep>.
+=item B<pos_validated_list( \@_, $spec, $spec, ... )>
+
+This function validates a list of positional parameters. Each C<$spec>
+should validate one of the parameters in the list:
+
+ sub foo {
+ my $self = shift;
+ my ( $foo, $bar ) = pos_validated_list(
+ \@_,
+ { isa => 'Foo' },
+ { isa => 'Bar' },
+ );
+
+ ...
+ }
+
+Unlike the other functions, this function I<cannot> find C<$self> in
+the argument list. Make sure to shift it off yourself before doing
+validation.
+
+If a parameter is marked as optional and is not present, it will
+simply not be returned.
+
+If you want to pass in any of the cache control parameters described
+below, simply pass them after the list of parameter validation specs:
+
+ sub foo {
+ my $self = shift;
+ my ( $foo, $bar ) = pos_validated_list(
+ \@_,
+ { isa => 'Foo' },
+ { isa => 'Bar' },
+ MX_PARAMS_VALIDATE_NO_CACHE => 1,
+ );
+
+ ...
+ }
+
=back
=head1 EXPORTS
@@ -327,15 +421,31 @@
=item *
Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter
-spec this will prevent the parameter spec from being cached. To see an
-example of this, take a look at F<t/003_nocache_flag.t>.
+spec this will prevent the parameter spec from being cached.
+ sub foo {
+ my ( $self, %params ) = validated_hash(
+ \@_,
+ foo => { isa => 'Foo' },
+ MX_PARAMS_VALIDATE_NO_CACHE => 1,
+ );
+
+ }
+
=item *
Passing in C<MX_PARAMS_VALIDATE_CACHE_KEY> with a value to be used as
-the cache key will bypass the normal cache key generation. To see an
-example of this, take a look at F<t/004_custom_cache_key.t>.
+the cache key will bypass the normal cache key generation.
+ sub foo {
+ my ( $self, %params ) = validated_hash(
+ \@_,
+ foo => { isa => 'Foo' },
+ MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42',
+ );
+
+ }
+
=back
=head1 BUGS
@@ -344,13 +454,15 @@
exception. If you find a bug please either email me, or add the bug to
cpan-RT.
-=head1 AUTHOR
+=head1 AUTHORS
Stevan Little E<lt>stevan.little at iinteractive.comE<gt>
+Dave Rolsky E<lt>autarch at urth.orgE<gt>
+
=head1 COPYRIGHT AND LICENSE
-Copyright 2007-2008 by Infinity Interactive, Inc.
+Copyright 2007-2009 by Infinity Interactive, Inc.
L<http://www.iinteractive.com>
Added: MooseX-Params-Validate/trunk/t/008_positional.t
===================================================================
--- MooseX-Params-Validate/trunk/t/008_positional.t (rev 0)
+++ MooseX-Params-Validate/trunk/t/008_positional.t 2009-02-01 16:16:51 UTC (rev 7470)
@@ -0,0 +1,151 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 31;
+use Test::Exception;
+
+{
+ package Roles::Blah;
+ use Moose::Role;
+ use MooseX::Params::Validate;
+
+ requires 'bar';
+ requires 'baz';
+
+ sub foo {
+ my ( $self, %params ) = validated_hash(
+ \@_,
+ bar => { isa => 'Str', default => 'Moose' },
+ );
+ return "Horray for $params{bar}!";
+ }
+
+ package Foo;
+ use Moose;
+ use Moose::Util::TypeConstraints;
+ use MooseX::Params::Validate;
+
+ with 'Roles::Blah';
+
+ sub bar {
+ my $self = shift;
+ return [
+ pos_validated_list(
+ \@_,
+ { isa => 'Foo' },
+ { isa => 'ArrayRef | HashRef', optional => 1 },
+ { isa => 'ArrayRef[Int]', optional => 1 },
+ )
+ ];
+ }
+
+ sub baz {
+ my $self = shift;
+ return [
+ pos_validated_list(
+ \@_,
+ {
+ isa => subtype( 'Object' => where { $_->isa('Foo') } ),
+ optional => 1
+ },
+ { does => 'Roles::Blah', optional => 1 },
+ {
+ does => subtype(
+ 'Role' => where { $_->does('Roles::Blah') }
+ ),
+ optional => 1
+ },
+ )
+ ];
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+is( $foo->baz($foo)->[0], $foo, '... first param must be a Foo instance' );
+
+throws_ok { $foo->baz(10) } qr/\QParameter #1 ("10")/,
+ '... the first param in &baz must be a Foo instance';
+throws_ok { $foo->baz('foo') } qr/\QParameter #1 ("foo")/,
+ '... the first param in &baz must be a Foo instance';
+throws_ok { $foo->baz( [] ) } qr/\QParameter #1/,
+ '... the first param in &baz must be a Foo instance';
+
+is( $foo->baz( $foo, $foo )->[1], $foo,
+ '... second param must do Roles::Blah' );
+
+throws_ok { $foo->baz( $foo, 10 ) } qr/\QParameter #2 ("10")/,
+ '... the second param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( $foo, 'foo' ) } qr/\QParameter #2 ("foo")/,
+ '... the second param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( $foo, [] ) } qr/\QParameter #2/,
+ '... the second param in &baz must be do Roles::Blah';
+
+is( $foo->baz( $foo, $foo, $foo )->[2], $foo,
+ '... third param must do Roles::Blah' );
+
+throws_ok { $foo->baz( $foo, $foo, 10 ) } qr/\QParameter #3 ("10")/,
+ '... the third param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( $foo, $foo, "foo" ) } qr/\QParameter #3 ("foo")/,
+ '... the third param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( $foo, $foo, [] ) } qr/\QParameter #3/,
+ '... the third param in &baz must be do Roles::Blah';
+
+throws_ok { $foo->bar } qr/\Q0 parameters were passed/,
+ '... bar has a required params';
+throws_ok { $foo->bar(10) } qr/\QParameter #1 ("10")/,
+ '... the first param in &bar must be a Foo instance';
+throws_ok { $foo->bar('foo') } qr/\QParameter #1 ("foo")/,
+ '... the first param in &bar must be a Foo instance';
+throws_ok { $foo->bar( [] ) } qr/\QParameter #1/,
+ '... the first param in &bar must be a Foo instance';
+throws_ok { $foo->bar() } qr/\Q0 parameters were passed/,
+ '... bar has a required first param';
+
+is_deeply(
+ $foo->bar($foo),
+ [$foo],
+ '... the first param in &bar got a Foo instance'
+);
+
+is_deeply(
+ $foo->bar( $foo, [] ),
+ [ $foo, [] ],
+ '... the first and second param in &bar got correct args'
+);
+
+is_deeply(
+ $foo->bar( $foo, {} ),
+ [ $foo, {} ],
+ '... the first param and baz param in &bar got correct args'
+);
+
+throws_ok { $foo->bar( $foo, undef ) } qr/\QParameter #2 (undef)/,
+ '... second param requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( $foo, 10 ) } qr/\QParameter #2 ("10")/,
+ '... second param requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( $foo, 'Foo' ) } qr/\QParameter #2 ("Foo")/,
+ '... second param requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( $foo, \( my $var ) ) } qr/\QParameter #2/,
+ '... second param requires a ArrayRef | HashRef';
+
+is_deeply(
+ $foo->bar( $foo, {}, [ 1, 2, 3 ] ),
+ [ $foo, {}, [ 1, 2, 3 ] ],
+ '... the first param in &bar got a Foo instance'
+);
+
+throws_ok { $foo->bar( $foo, {}, undef ) } qr/\QParameter #3 (undef)/,
+'... third param a ArrayRef[Int]';
+throws_ok { $foo->bar( $foo, {}, 10 ) } qr/\QParameter #3 ("10")/,
+'... third param a ArrayRef[Int]';
+throws_ok { $foo->bar( $foo, {}, 'Foo' ) } qr/\QParameter #3 ("Foo")/,
+'... third param a ArrayRef[Int]';
+throws_ok { $foo->bar( $foo, {}, \( my $var ) ) } qr/\QParameter #3/,
+'... third param a ArrayRef[Int]';
+throws_ok { $foo->bar( $foo, {}, [qw/one two three/] ) } qr/\QParameter #3/,
+'... third param a ArrayRef[Int]';
+
Property changes on: MooseX-Params-Validate/trunk/t/008_positional.t
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Rev
Name: svn:eol-style
+ native
More information about the Moose-commits
mailing list