--- /dev/null
+Revision history for Perl extension MooseX-Params-Validate
+
+0.13 Sun., Nov. 29, 2009
+ - Fix so that validated_hash does not try to coerce optional
+ parameters which are not present. Patch by Ian Sillitoe.
+
+ - Same fix for pos_validated_list. (Dave Rolsky)
+
+0.12 Tue. Jul. 7, 2009
+ - Using the subroutine name as a cache key for validation specs
+ broke in the face of method modifiers, which all appear to have
+ the same name. Now we use Devel::Caller to get the CV of the
+ caller and use its refaddr as the key, which will be unique in
+ all cases. Bug report by Jos Boumans. RT #46730.
+
+0.11 Tue. Jul. 7, 2009
+ - The validation functions tried to coerce optional keys which
+ weren't present in the incoming parameters, leading to weird
+ errors. Based on a patch from Jos Boumans. RT #46344.
+
+ - Allow other callbacks to be specified. Previously these were
+ silently thrown out. But we'd recommend just defining types that
+ encapsulate everything in the callback instead. Based on a patch
+ from Jos Boumans. RT #47647.
+
+0.10 Tue. Jun. 30, 2009
+ - Shut up deprecation warnings from the tests. Reported by John
+ Goulah.
+
+0.09 Sun. Feb. 1, 2009
+ - The subroutine name being reported in error messages was screwy.
+
+0.08 Sun. Feb. 1, 2009
+ - Renamed validate to validated_hash and validatep to
+ validated_list. The old function names are still available under
+ the ":deprecated" import tag.
+
+ - Added a new pos_validated_list which can validate position
+ parameters.
+
+ - Errors now reflect the subroutine that called the validation
+ function, rather than coming form inside the validation function
+ itself.
+
+0.07 Sun. Sep. 21, 2008
+ - No code changes, just fixing missing prereqs (Dave Rolsky)
+
+0.06 Sat. Sep. 20, 2008
+ - Fixes to work with Moose 0.58 (Dave Rolsky)
+
+ - Switched to using Module::Install (Dave Rolsky)
+
+0.05 Fri. Mar. 7th, 2008
+ - This package would cause a fatal error if loaded
+ by a non-Moose class (Dave Rolsky)
+ - added tests for this (Dave Rolsky)
+
+ - Added support for coercions (Dave Rolsky)
+
+0.04 Tues. Jan. 8th, 2008
+ - upped the Moose dependency and added support
+ for the new improved Moose type constraints
+ - added tests for this
+
+ - adding caching of the prepared parameter
+ specs, this results in approx. 3x speedup
+ using rough benchmarks.
+
+ - added special caching handlers see the
+ IMPORTANT NOTE ON CACHING section of the
+ POD for more details
+ - added tests for this
+
+0.03 Fri. June 8th, 2007
+ - added support for using this
+ within role methods too.
+
+0.02 Wed. April 25, 2007
+ - added validatep, which returns the captured
+ args as positional instead of as hash
+ - added docs and tests
+
+0.01 Wed. April 18, 2007
+ - trying to fill a gap, we will see ...
--- /dev/null
+^_build
+^Build$
+^blib
+~$
+\.bak$
+^MANIFEST\.SKIP$
+CVS
+\.svn
+\.DS_Store
+cover_db
+\..*\.sw.?$
+^Makefile$
+^pm_to_blib$
+^MakeMaker-\d
+^blibdirs$
+\.old$
+^#.*#$
+^\.#
+^TODO$
+^\.shipit
--- /dev/null
+use strict;
+use warnings;
+use inc::Module::Install 0.91;
+
+name 'MooseX-Params-Validate';
+all_from 'lib/MooseX/Params/Validate.pm';
+
+
+requires 'Carp' => '0';
+requires 'Devel::Caller' => '0';
+requires 'Moose' => '0.58';
+requires 'Params::Validate' => '0.88';
+requires 'Scalar::Util' => '0';
+requires 'Sub::Exporter' => '0';
+
+build_requires 'Test::More' => '0.62';
+build_requires 'Test::Exception' => '0.21';
+
+license 'Perl';
+
+resources repository => 'http://code2.0beta.co.uk/moose/svn/MooseX-Params-Validate';
+
+WriteAll();
--- /dev/null
+MooseX::Params::Validate version 0.13
+===========================
+
+See the individual module documentation for more information
+
+INSTALLATION
+
+To install this module type the following:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ Moose
+ Params::Validate
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007-2008 Infinity Interactive, Inc.
+
+http://www.iinteractive.com
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
--- /dev/null
+package MooseX::Params::Validate;
+
+use strict;
+use warnings;
+
+use Carp 'confess';
+use Devel::Caller 'caller_cv';
+use Scalar::Util 'blessed', 'refaddr';
+
+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 pos_validated_list validate validatep )
+ ],
+ groups => {
+ default => [qw( validated_hash validated_list pos_validated_list )],
+ deprecated => [qw( validate validatep )],
+ },
+};
+
+our $VERSION = '0.13';
+our $AUTHORITY = 'cpan:STEVAN';
+
+my %CACHED_SPECS;
+
+sub validated_hash {
+ my ( $args, %spec ) = @_;
+
+ my $cache_key = _cache_key( \%spec );
+
+ if ( exists $CACHED_SPECS{$cache_key} ) {
+ ( ref $CACHED_SPECS{$cache_key} eq 'HASH' )
+ || confess
+ "I was expecting a HASH-ref in the cached $cache_key parameter"
+ . " spec, you are doing something funky, stop it!";
+ %spec = %{ $CACHED_SPECS{$cache_key} };
+ }
+ else {
+ my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
+
+ $spec{$_} = _convert_to_param_validate_spec( $spec{$_} )
+ foreach keys %spec;
+
+ $CACHED_SPECS{$cache_key} = \%spec
+ if $should_cache;
+ }
+
+ my $instance;
+ $instance = shift @$args if blessed $args->[0];
+
+ my %args = @$args;
+
+ $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
+ for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
+
+ %args = Params::Validate::validate_with(
+ params => \%args,
+ spec => \%spec,
+ called => _caller_name(),
+ );
+
+ return ( ( defined $instance ? $instance : () ), %args );
+}
+
+*validate = \&validated_hash;
+
+sub validated_list {
+ my ( $args, @spec ) = @_;
+
+ my %spec = @spec;
+
+ my $cache_key = _cache_key( \%spec );
+
+ my @ordered_spec;
+ if ( exists $CACHED_SPECS{$cache_key} ) {
+ ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
+ || confess
+ "I was expecting a ARRAY-ref in the cached $cache_key parameter"
+ . " spec, you are doing something funky, stop it!";
+ %spec = %{ $CACHED_SPECS{$cache_key}->[0] };
+ @ordered_spec = @{ $CACHED_SPECS{$cache_key}->[1] };
+ }
+ else {
+ my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
+
+ @ordered_spec = grep { exists $spec{$_} } @spec;
+
+ $spec{$_} = _convert_to_param_validate_spec( $spec{$_} )
+ foreach keys %spec;
+
+ $CACHED_SPECS{$cache_key} = [ \%spec, \@ordered_spec ]
+ if $should_cache;
+ }
+
+ my $instance;
+ $instance = shift @$args if blessed $args->[0];
+
+ my %args = @$args;
+
+ $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
+ for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
+
+ %args = Params::Validate::validate_with(
+ params => \%args,
+ spec => \%spec,
+ called => _caller_name(),
+ );
+
+ return (
+ ( defined $instance ? $instance : () ),
+ @args{@ordered_spec}
+ );
+}
+
+*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[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
+
+ @args = Params::Validate::validate_with(
+ params => \@args,
+ spec => \@pv_spec,
+ called => _caller_name(),
+ );
+
+ return @args;
+}
+
+sub _cache_key {
+ my $spec = shift;
+
+ if ( exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY} ) {
+ return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
+ }
+ else {
+ return refaddr( caller_cv(2) );
+ }
+}
+
+sub _convert_to_param_validate_spec {
+ my ($spec) = @_;
+ my %pv_spec;
+
+ $pv_spec{optional} = $spec->{optional}
+ if exists $spec->{optional};
+
+ $pv_spec{default} = $spec->{default}
+ if exists $spec->{default};
+
+ $pv_spec{coerce} = $spec->{coerce}
+ if exists $spec->{coerce};
+
+ my $constraint;
+ if ( defined $spec->{isa} ) {
+ $constraint
+ = _is_tc( $spec->{isa} )
+ || Moose::Util::TypeConstraints::find_or_parse_type_constraint(
+ $spec->{isa} )
+ || class_type( $spec->{isa} );
+ }
+ elsif ( defined $spec->{does} ) {
+ $constraint
+ = _is_tc( $spec->{isa} )
+ || find_type_constraint( $spec->{does} )
+ || role_type( $spec->{does} );
+ }
+
+ $pv_spec{callbacks} = $spec->{callbacks}
+ if exists $spec->{callbacks};
+
+ if ($constraint) {
+ $pv_spec{constraint} = $constraint;
+
+ $pv_spec{callbacks}
+ { 'checking type constraint for ' . $constraint->name }
+ = sub { $constraint->check( $_[0] ) };
+ }
+
+ delete $pv_spec{coerce}
+ unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion;
+
+ return \%pv_spec;
+}
+
+sub _is_tc {
+ my $maybe_tc = shift;
+
+ return $maybe_tc
+ if defined $maybe_tc
+ && blessed $maybe_tc
+ && $maybe_tc->isa('Moose::Meta::TypeConstraint');
+}
+
+sub _caller_name {
+ my $depth = shift || 0;
+
+ return ( caller( 2 + $depth ) )[3];
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+MooseX::Params::Validate - an extension of Params::Validate for using Moose's types
+
+=head1 SYNOPSIS
+
+ package Foo;
+ use Moose;
+ use MooseX::Params::Validate;
+
+ sub foo {
+ my ( $self, %params ) = validated_hash(
+ \@_,
+ bar => { isa => 'Str', default => 'Moose' },
+ );
+ return "Horray for $params{bar}!";
+ }
+
+ sub bar {
+ my $self = shift;
+ my ( $foo, $baz, $gorch ) = validated_list(
+ \@_,
+ foo => { isa => 'Foo' },
+ baz => { isa => 'ArrayRef | HashRef', optional => 1 },
+ gorch => { isa => 'ArrayRef[Int]', optional => 1 }
+ );
+ [ $foo, $baz, $gorch ];
+ }
+
+=head1 DESCRIPTION
+
+This module fills a gap in Moose by adding method parameter validation
+to Moose. This is just one of many developing options, it should not
+be considered the "official" one by any means though.
+
+You might also want to explore C<MooseX::Method::Signatures> and
+C<MooseX::Declare>
+
+=head1 CAVEATS
+
+It is not possible to introspect the method parameter specs, they are
+created as needed when the method is called and cached for subsequent
+calls.
+
+=head1 EXPORTS
+
+=over 4
+
+=item B<validated_hash( \@_, %parameter_spec )>
+
+This behaves similar to the standard Params::Validate C<validate>
+function and returns the captured values in a HASH. The one exception
+being that if it spots an instance in the C<@_>, then it will handle
+it appropriately (unlike Params::Validate which forces you to shift
+you C<$self> first).
+
+The C<%parameter_spec> accepts the following options:
+
+=over 4
+
+=item I<isa>
+
+The C<isa> option can be either; class name, Moose type constraint
+name or an anon Moose type constraint.
+
+=item I<does>
+
+The C<does> option can be either; role name or an anon Moose type
+constraint.
+
+=item I<default>
+
+This is the default value to be used if the value is not supplied.
+
+=item I<optional>
+
+As with Params::Validate, all options are considered required unless
+otherwise specified. This option is passed directly to
+Params::Validate.
+
+=item I<coerce>
+
+If this is true and the parameter has a type constraint which has
+coercions, then the coercion will be called for this parameter. If the
+type does have coercions, then this parameter is ignored.
+
+=back
+
+This function is also available under its old name, C<validate>.
+
+=item B<validated_list( \@_, %parameter_spec )>
+
+The C<%parameter_spec> accepts the same options as above, but returns
+the parameters as positional values instead of a HASH. This is best
+explained by example:
+
+ sub foo {
+ my ( $self, $foo, $bar ) = validated_list(
+ \@_,
+ foo => { isa => 'Foo' },
+ bar => { isa => 'Bar' },
+ );
+ $foo->baz($bar);
+ }
+
+We capture the order in which you defined the parameters and then
+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
+
+By default, this module exports the C<validated_hash>,
+C<validated_list>, and C<pos_validated_list>.
+
+If you would prefer to import the now deprecated functions C<validate>
+and C<validatep> instead, you can use the C<:deprecated> tag to import
+them.
+
+=head1 IMPORTANT NOTE ON CACHING
+
+When C<validate> or C<validatep> are called the first time, the
+parameter spec is prepared and cached to avoid unnecessary
+regeneration. It uses the fully qualified name of the subroutine
+(package + subname) as the cache key. In 99.999% of the use cases for
+this module, that will be the right thing to do.
+
+However, I have (ab)used this module occasionally to handle dynamic
+sets of parameters. In this special use case you can do a couple
+things to better control the caching behavior.
+
+=over 4
+
+=item *
+
+Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter
+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.
+
+ sub foo {
+ my ( $self, %params ) = validated_hash(
+ \@_,
+ foo => { isa => 'Foo' },
+ MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42',
+ );
+
+ }
+
+=back
+
+=head1 BUGS
+
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug to
+cpan-RT.
+
+=head1 AUTHORS
+
+Stevan Little E<lt>stevan.little@iinteractive.comE<gt>
+
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2007-2009 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+BEGIN {
+ # this module doesn't export to main
+ package Testing;
+ ::use_ok('MooseX::Params::Validate');
+}
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 35;
+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;
+ my %params = validated_hash(
+ \@_,
+ foo => { isa => 'Foo' },
+ baz => { isa => 'ArrayRef | HashRef', optional => 1 },
+ gorch => { isa => 'ArrayRef[Int]', optional => 1 },
+ );
+ [ $params{foo}, $params{baz}, $params{gorch} ];
+ }
+
+ sub baz {
+ my $self = shift;
+ my %params = validated_hash(
+ \@_,
+ foo => {
+ isa => subtype( 'Object' => where { $_->isa('Foo') } ),
+ optional => 1
+ },
+ bar => { does => 'Roles::Blah', optional => 1 },
+ boo => {
+ does => role_type('Roles::Blah'),
+ optional => 1
+ },
+ );
+ return $params{foo} || $params{bar} || $params{boo};
+ }
+
+ sub quux {
+ my $self = shift;
+ my %params = validated_hash(
+ \@_,
+ foo => {
+ isa => 'ArrayRef',
+ callbacks => {
+ 'some random callback' => sub { @{ $_[0] } <= 2 },
+ },
+ },
+ );
+
+ return $params{foo};
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+is( $foo->foo, 'Horray for Moose!', '... got the right return value' );
+is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
+ '... got the right return value' );
+
+is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
+
+throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
+ '... the foo param in &baz must be a Foo instance';
+throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
+ '... the foo param in &baz must be a Foo instance';
+throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/,
+ '... the foo param in &baz must be a Foo instance';
+
+is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
+
+throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/,
+'... the bar param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/,
+'... the bar param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/,
+'... the bar param in &baz must be do Roles::Blah';
+
+is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
+
+throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/,
+'... the boo param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/,
+'... the boo param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/,
+'... the boo param in &baz must be do Roles::Blah';
+
+throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/,
+ '... bar has a required param';
+throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,,
+ '... bar has a required foo param';
+
+is_deeply(
+ $foo->bar( foo => $foo ),
+ [ $foo, undef, undef ],
+ '... the foo param in &bar got a Foo instance'
+);
+
+is_deeply(
+ $foo->bar( foo => $foo, baz => [] ),
+ [ $foo, [], undef ],
+ '... the foo param and baz param in &bar got a correct args'
+);
+
+is_deeply(
+ $foo->bar( foo => $foo, baz => {} ),
+ [ $foo, {}, undef ],
+ '... the foo param and baz param in &bar got a correct args'
+);
+
+throws_ok { $foo->bar( foo => $foo, baz => undef ) }
+qr/\QThe 'baz' parameter (undef)/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => 10 ) }
+qr/\QThe 'baz' parameter ("10")/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) }
+qr/\QThe 'baz' parameter ("Foo")/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) }
+qr/\QThe 'baz' parameter/,
+ '... baz requires a ArrayRef | HashRef';
+
+is_deeply(
+ $foo->bar( foo => $foo, gorch => [ 1, 2, 3 ] ),
+ [ $foo, undef, [ 1, 2, 3 ] ],
+ '... the foo param in &bar got a Foo instance'
+);
+
+throws_ok { $foo->bar( foo => $foo, gorch => undef ) }
+qr/\QThe 'gorch' parameter (undef)/,
+ '... gorch requires a ArrayRef[Int]';
+throws_ok { $foo->bar( foo => $foo, gorch => 10 ) }
+qr/\QThe 'gorch' parameter ("10")/,
+ '... gorch requires a ArrayRef[Int]';
+throws_ok { $foo->bar( foo => $foo, gorch => 'Foo' ) }
+qr/\QThe 'gorch' parameter ("Foo")/,
+ '... gorch requires a ArrayRef[Int]';
+throws_ok { $foo->bar( foo => $foo, gorch => \( my $var ) ) }
+qr/\QThe 'gorch' parameter/,
+ '... gorch requires a ArrayRef[Int]';
+throws_ok { $foo->bar( foo => $foo, gorch => [qw/one two three/] ) }
+qr/\QThe 'gorch' parameter/,
+ '... gorch requires a ArrayRef[Int]';
+
+throws_ok { $foo->quux( foo => '123456790' ) }
+qr/\QThe 'foo' parameter\E.+\Qchecking type constraint/,
+'... foo parameter must be an ArrayRef';
+
+throws_ok { $foo->quux( foo => [ 1, 2, 3, 4 ] ) }
+qr/\QThe 'foo' parameter\E.+\Qsome random callback/,
+'... foo parameter additional callback requires that arrayref be 0-2 elements';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 27;
+use Test::Exception;
+
+{
+ package Roles::Blah;
+ use Moose::Role;
+
+ requires 'foo';
+ requires 'bar';
+ requires 'baz';
+
+ package Foo;
+ use Moose;
+ use Moose::Util::TypeConstraints;
+ use MooseX::Params::Validate;
+
+ with 'Roles::Blah';
+
+ sub foo {
+ my ( $self, $bar ) = validated_list(
+ \@_,
+ bar => { isa => 'Str', default => 'Moose' },
+ );
+ return "Horray for $bar!";
+ }
+
+ sub bar {
+ my $self = shift;
+ my ( $foo, $baz ) = validated_list(
+ \@_,
+ foo => { isa => 'Foo' },
+ baz => { isa => 'ArrayRef | HashRef', optional => 1 },
+ );
+ [ $foo, $baz ];
+ }
+
+ sub baz {
+ my $self = shift;
+ my ( $foo, $bar, $boo ) = validated_list(
+ \@_,
+ foo => {
+ isa => subtype( 'Object' => where { $_->isa('Foo') } ),
+ optional => 1
+ },
+ bar => { does => 'Roles::Blah', optional => 1 },
+ boo => {
+ does => role_type('Roles::Blah'),
+ optional => 1
+ },
+ );
+ return $foo || $bar || $boo;
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+is( $foo->foo, 'Horray for Moose!', '... got the right return value' );
+is( $foo->foo( bar => 'Rolsky' ), 'Horray for Rolsky!',
+ '... got the right return value' );
+
+is( $foo->baz( foo => $foo ), $foo, '... foo param must be a Foo instance' );
+
+throws_ok { $foo->baz( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
+ '... the foo param in &baz must be a Foo instance';
+throws_ok { $foo->baz( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
+ '... the foo param in &baz must be a Foo instance';
+throws_ok { $foo->baz( foo => [] ) } qr/\QThe 'foo' parameter/,
+ '... the foo param in &baz must be a Foo instance';
+
+is( $foo->baz( bar => $foo ), $foo, '... bar param must do Roles::Blah' );
+
+throws_ok { $foo->baz( bar => 10 ) } qr/\QThe 'bar' parameter ("10")/,
+'... the bar param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( bar => "foo" ) } qr/\QThe 'bar' parameter ("foo")/,
+'... the bar param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( bar => [] ) } qr/\QThe 'bar' parameter/,
+'... the bar param in &baz must be do Roles::Blah';
+
+is( $foo->baz( boo => $foo ), $foo, '... boo param must do Roles::Blah' );
+
+throws_ok { $foo->baz( boo => 10 ) } qr/\QThe 'boo' parameter ("10")/,
+'... the boo param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( boo => "foo" ) } qr/\QThe 'boo' parameter ("foo")/,
+'... the boo param in &baz must be do Roles::Blah';
+throws_ok { $foo->baz( boo => [] ) } qr/\QThe 'boo' parameter/,
+'... the boo param in &baz must be do Roles::Blah';
+
+throws_ok { $foo->bar } qr/\QMandatory parameter 'foo'/,
+ '... bar has a required param';
+throws_ok { $foo->bar( foo => 10 ) } qr/\QThe 'foo' parameter ("10")/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( foo => "foo" ) } qr/\QThe 'foo' parameter ("foo")/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( foo => [] ) } qr/\QThe 'foo' parameter/,
+ '... the foo param in &bar must be a Foo instance';
+throws_ok { $foo->bar( baz => [] ) } qr/\QMandatory parameter 'foo'/,,
+ '... bar has a required foo param';
+
+is_deeply(
+ $foo->bar( foo => $foo ),
+ [ $foo, undef ],
+ '... the foo param in &bar got a Foo instance'
+);
+
+is_deeply(
+ $foo->bar( foo => $foo, baz => [] ),
+ [ $foo, [] ],
+ '... the foo param and baz param in &bar got a correct args'
+);
+
+is_deeply(
+ $foo->bar( foo => $foo, baz => {} ),
+ [ $foo, {} ],
+ '... the foo param and baz param in &bar got a correct args'
+);
+
+throws_ok { $foo->bar( foo => $foo, baz => undef ) }
+qr/\QThe 'baz' parameter (undef)/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => 10 ) }
+qr/\QThe 'baz' parameter ("10")/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => 'Foo' ) }
+qr/\QThe 'baz' parameter ("Foo")/,
+ '... baz requires a ArrayRef | HashRef';
+throws_ok { $foo->bar( foo => $foo, baz => \( my $var ) ) }
+qr/\QThe 'baz' parameter/,
+ '... baz requires a ArrayRef | HashRef';
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use Test::Exception;
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Params::Validate;
+
+ sub bar {
+ my ( $self, $args, $params ) = @_;
+ $params->{MX_PARAMS_VALIDATE_NO_CACHE}++;
+ return validated_hash( $args, %$params );
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+lives_ok {
+ $foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
+}
+'... successfully applied the parameter validation';
+
+lives_ok {
+ $foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
+}
+'... successfully applied the parameter validation (look mah no cache)';
+
+lives_ok {
+ $foo->bar( [ baz => { one => 1 } ], { baz => { isa => 'HashRef' } } );
+}
+'... successfully applied the parameter validation (look mah no cache) (just checkin)';
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+use Test::Exception;
+use Scalar::Util;
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Params::Validate;
+
+ sub bar {
+ my ( $self, $args, $params ) = @_;
+ $params->{MX_PARAMS_VALIDATE_CACHE_KEY}
+ = Scalar::Util::refaddr($self);
+ return validated_hash( $args, %$params );
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+lives_ok {
+ $foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
+}
+'... successfully applied the parameter validation';
+
+throws_ok {
+ $foo->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
+} qr/\QThe 'baz' parameter/,
+'... successfully re-used the parameter validation for this instance';
+
+my $foo2 = Foo->new;
+isa_ok( $foo2, 'Foo' );
+
+lives_ok {
+ $foo2->bar( [ baz => [ 1, 2, 3 ] ], { baz => { isa => 'ArrayRef' } } );
+}
+'... successfully applied the parameter validation';
+
+throws_ok {
+ $foo2->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
+} qr/\QThe 'baz' parameter/,
+'... successfully re-used the parameter validation for this instance';
+
+lives_ok {
+ $foo->bar( [ baz => 1 ], { baz => { isa => 'Int' } } );
+}
+'... successfully applied the parameter validation (just checking)';
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 15;
+use Test::Exception;
+
+# Note that setting coerce => 1 for the Num type tests that we don't try to do
+# coercions for a type which doesn't have any coercions.
+{
+ package Foo;
+ use Moose;
+ use Moose::Util::TypeConstraints;
+ use MooseX::Params::Validate;
+
+ subtype 'Size' => as 'Int' => where { $_ >= 0 };
+
+ coerce 'Size' => from 'ArrayRef' => via { scalar @{$_} };
+
+ sub bar {
+ my $self = shift;
+ my %params = validated_hash(
+ \@_,
+ size1 => { isa => 'Size', coerce => 1 },
+ size2 => { isa => 'Size', coerce => 0 },
+ number => { isa => 'Num', coerce => 1 },
+ );
+ [ $params{size1}, $params{size2}, $params{number} ];
+ }
+
+ # added to test 'optional' on validated_hash
+ sub baropt {
+ my $self = shift;
+ my %params = validated_hash(
+ \@_,
+ size1 => { isa => 'Size', coerce => 1, optional => 1 },
+ size2 => { isa => 'Size', coerce => 0, optional => 1 },
+ number => { isa => 'Num', coerce => 1, optional => 1 },
+ );
+ [ $params{size1}, $params{size2}, $params{number} ];
+ }
+
+
+ sub baz {
+ my $self = shift;
+ my ( $size1, $size2, $number ) = validated_list(
+ \@_,
+ size1 => { isa => 'Size', coerce => 1 },
+ size2 => { isa => 'Size', coerce => 0 },
+ number => { isa => 'Num', coerce => 1 },
+ );
+ [ $size1, $size2, $number ];
+ }
+
+
+ sub quux {
+ my $self = shift;
+ my ( $size1, $size2, $number ) = validated_list(
+ \@_,
+ size1 => { isa => 'Size', coerce => 1, optional => 1 },
+ size2 => { isa => 'Size', coerce => 0, optional => 1 },
+ number => { isa => 'Num', coerce => 1, optional => 1 },
+ );
+ [ $size1, $size2, $number ];
+ }
+
+ sub ran_out {
+ my $self = shift;
+ my ( $size1, $size2, $number ) = pos_validated_list(
+ \@_,
+ { isa => 'Size', coerce => 1, optional => 1 },
+ { isa => 'Size', coerce => 0, optional => 1 },
+ { isa => 'Num', coerce => 1, optional => 1 },
+ );
+ [ $size1, $size2, $number ];
+ }
+}
+
+my $foo = Foo->new;
+isa_ok( $foo, 'Foo' );
+
+is_deeply(
+ $foo->bar( size1 => 10, size2 => 20, number => 30 ),
+ [ 10, 20, 30 ],
+ 'got the return value right without coercions'
+);
+
+is_deeply(
+ $foo->bar( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
+ [ 3, 20, 30 ],
+ 'got the return value right with coercions for size1'
+);
+
+throws_ok { $foo->bar( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
+qr/\QThe 'size2' parameter/,
+ '... the size2 param cannot be coerced';
+
+throws_ok { $foo->bar( size1 => 30, size2 => 10, number => 'something' ) }
+qr/\QThe 'number' parameter/,
+ '... the number param cannot be coerced because there is no coercion defined for Num';
+
+is_deeply(
+ $foo->baz( size1 => 10, size2 => 20, number => 30 ),
+ [ 10, 20, 30 ],
+ 'got the return value right without coercions'
+);
+
+is_deeply(
+ $foo->baz( size1 => [ 1, 2, 3 ], size2 => 20, number => 30 ),
+ [ 3, 20, 30 ],
+ 'got the return value right with coercions for size1'
+);
+
+throws_ok { $foo->baz( size1 => 30, size2 => [ 1, 2, 3 ], number => 30 ) }
+qr/\QThe 'size2' parameter/,
+ '... the size2 param cannot be coerced';
+
+throws_ok { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
+qr/\QThe 'number' parameter/,
+ '... the number param cannot be coerced';
+
+is_deeply(
+ $foo->baropt( size2 => 4 ),
+ [ undef, 4, undef ],
+ '... validated_hash does not try to coerce keys which are not provided'
+);
+
+is_deeply(
+ $foo->quux( size2 => 4 ),
+ [ undef, 4, undef ],
+ '... validated_list does not try to coerce keys which are not provided'
+);
+
+is_deeply(
+ $foo->ran_out( 1, 2, 3 ),
+ [ 1, 2, 3 ],
+ 'got the return value right without coercions'
+);
+
+is_deeply(
+ $foo->ran_out( [1], 2, 3 ),
+ [ 1, 2, 3 ],
+ 'got the return value right with coercion for the first param'
+);
+
+throws_ok { $foo->ran_out( [ 1, 2 ], [ 1, 2 ] ) }
+qr/\QParameter #2/,
+ '... did not attempt to coerce the second parameter';
+
+
+is_deeply(
+ $foo->ran_out(),
+ [ undef, undef, undef ],
+ 'did not try to coerce non-existent parameters'
+);
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+eval <<'EOF';
+{
+ package Foo;
+ use MooseX::Params::Validate;
+}
+EOF
+
+is(
+ $@, '',
+ 'loading MX::Params::Validate in a non-Moose class does not blow up'
+);
+ok( Foo->can('validated_hash'), 'validated_hash() sub was added to Foo package' );
--- /dev/null
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+{
+ package Foo;
+
+ use Moose;
+ use MooseX::Params::Validate qw( :deprecated );
+
+}
+
+ok( Foo->can('validate'), ':deprecated tag exports validate' );
+ok( Foo->can('validatep'), ':deprecated tag exports validatep' );
--- /dev/null
+#!/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 => role_type('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]';
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 2;
+use Test::Exception;
+
+{
+ package Foo;
+ use Moose;
+ use MooseX::Params::Validate;
+
+ sub foo {
+ my $self = shift;
+ my %params = validated_hash(
+ \@_,
+ foo => { isa => 'Str' },
+ );
+ return $params{foo};
+ }
+
+ around 'foo' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my %p = @_;
+
+ my @args = ( bar => delete $p{bar} );
+
+ my %params = validated_hash(
+ \@args,
+ bar => { isa => 'Str' },
+ );
+
+ $params{bar}, $self->$orig(%p);
+ };
+
+ around 'foo' => sub {
+ my $orig = shift;
+ my $self = shift;
+ my %p = @_;
+
+ my @args = ( quux => delete $p{quux} );
+
+ my %params = validated_hash(
+ \@args,
+ quux => { isa => 'Str' },
+ );
+
+ $params{quux}, $self->$orig(%p);
+ };
+}
+
+{
+ my $foo = Foo->new;
+
+ is_deeply( [ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
+ [ 3, 2, 1 ],
+ 'multiple around wrappers can safely be cached' );
+
+ is_deeply( [ $foo->foo( foo => 1, bar => 2, quux => 3 ) ],
+ [ 3, 2, 1 ],
+ 'multiple around wrappers can safely be cached (2nd time)' );
+}
+
--- /dev/null
+
+package Foo;
+use Moose;
+use MooseX::Params::Validate;
+use overload (
+ qw{""} => 'to_string',
+);
+
+has 'id' => ( is => 'ro', isa => 'Str', default => '1.10.100' );
+
+sub to_string {
+ my ($self, %args) = validated_hash( \@_,
+ padded => { isa => 'Bool', optional => 1, default => 0 },
+ );
+
+ # 1.10.100 => 0001.0010.0100
+ my $id = $args{ padded }
+ ? join( '.', map { sprintf( "%04d", $_ ) } split( /\./, $self->id ) )
+ : $self->id;
+
+ return $id;
+}
+
+package main;
+use Test::More tests => 4;
+use strict;
+use warnings;
+
+isa_ok( my $foo = Foo->new(), 'Foo', 'new' );
+
+is( $foo->id, '1.10.100', 'id' );
+
+is( $foo->to_string, '1.10.100', 'to_string' );
+
+is( $foo->to_string( padded => 1 ), '0001.0010.0100', 'to_string( padded => 1 )' );
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+
+all_pod_coverage_ok( { trustme => [ qr/^(?:validatep?|import)$/ ] } );
projects / gitmo/MooseX-Params-Validate.git / commitdiff