r39509 - in /branches/upstream/libmoosex-params-validate-perl/current: ChangeLog MANIFEST META.yml Makefile.PL README lib/MooseX/Params/Validate.pm t/001_basic.t t/005_coercion.t t/009_wrapped.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Wed Jul 8 19:31:07 UTC 2009
Author: jawnsy-guest
Date: Wed Jul 8 19:30:53 2009
New Revision: 39509
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=39509
Log:
[svn-upgrade] Integrating new upstream version, libmoosex-params-validate-perl (0.12)
Added:
branches/upstream/libmoosex-params-validate-perl/current/t/009_wrapped.t
Modified:
branches/upstream/libmoosex-params-validate-perl/current/ChangeLog
branches/upstream/libmoosex-params-validate-perl/current/MANIFEST
branches/upstream/libmoosex-params-validate-perl/current/META.yml
branches/upstream/libmoosex-params-validate-perl/current/Makefile.PL
branches/upstream/libmoosex-params-validate-perl/current/README
branches/upstream/libmoosex-params-validate-perl/current/lib/MooseX/Params/Validate.pm
branches/upstream/libmoosex-params-validate-perl/current/t/001_basic.t
branches/upstream/libmoosex-params-validate-perl/current/t/005_coercion.t
Modified: branches/upstream/libmoosex-params-validate-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/ChangeLog?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/ChangeLog (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/ChangeLog Wed Jul 8 19:30:53 2009
@@ -1,5 +1,22 @@
Revision history for Perl extension MooseX-Params-Validate
+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.
Modified: branches/upstream/libmoosex-params-validate-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/MANIFEST?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/MANIFEST (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/MANIFEST Wed Jul 8 19:30:53 2009
@@ -21,5 +21,6 @@
t/006_not_moose.t
t/007_deprecated.t
t/008_positional.t
+t/009_wrapped.t
t/pod.t
t/pod_coverage.t
Modified: branches/upstream/libmoosex-params-validate-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/META.yml?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/META.yml (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/META.yml Wed Jul 8 19:30:53 2009
@@ -21,10 +21,11 @@
- t
requires:
Carp: 0
+ Devel::Caller: 0
Moose: 0.58
Params::Validate: 0.88
Scalar::Util: 0
Sub::Exporter: 0
resources:
license: http://dev.perl.org/licenses/
-version: 0.10
+version: 0.12
Modified: branches/upstream/libmoosex-params-validate-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/Makefile.PL?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/Makefile.PL (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/Makefile.PL Wed Jul 8 19:30:53 2009
@@ -7,6 +7,7 @@
requires 'Carp' => '0';
+requires 'Devel::Caller' => '0';
requires 'Moose' => '0.58';
requires 'Params::Validate' => '0.88';
requires 'Scalar::Util' => '0';
Modified: branches/upstream/libmoosex-params-validate-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/README?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/README (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/README Wed Jul 8 19:30:53 2009
@@ -1,4 +1,4 @@
-MooseX::Params::Validate version 0.04
+MooseX::Params::Validate version 0.12
===========================
See the individual module documentation for more information
Modified: branches/upstream/libmoosex-params-validate-perl/current/lib/MooseX/Params/Validate.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/lib/MooseX/Params/Validate.pm?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/lib/MooseX/Params/Validate.pm (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/lib/MooseX/Params/Validate.pm Wed Jul 8 19:30:53 2009
@@ -4,7 +4,8 @@
use warnings;
use Carp 'confess';
-use Scalar::Util 'blessed';
+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 ();
@@ -18,7 +19,7 @@
},
};
-our $VERSION = '0.10';
+our $VERSION = '0.12';
our $AUTHORITY = 'cpan:STEVAN';
my %CACHED_SPECS;
@@ -98,7 +99,7 @@
my %args = @$args;
$args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
- for grep { $spec{$_}{coerce} } keys %spec;
+ for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
%args = Params::Validate::validate_with(
params => \%args,
@@ -163,7 +164,7 @@
return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
}
else {
- return _caller_name(1);
+ return refaddr( caller_cv(2) );
}
}
@@ -180,52 +181,45 @@
$pv_spec{coerce} = $spec->{coerce}
if exists $spec->{coerce};
- if ( exists $spec->{isa} ) {
- my $constraint;
-
- if ( blessed( $spec->{isa} )
- && $spec->{isa}->isa('Moose::Meta::TypeConstraint') ) {
- $constraint = $spec->{isa};
- }
- else {
- $constraint
- = Moose::Util::TypeConstraints::find_or_parse_type_constraint(
- $spec->{isa} )
- || class_type( $spec->{isa} );
- }
-
+ 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] ) }
- };
- }
- elsif ( exists $spec->{does} ) {
-
- my $constraint;
-
- if ( blessed( $spec->{does} )
- && $spec->{does}->isa('Moose::Meta::TypeConstraint') ) {
- $constraint = $spec->{does};
- }
- else {
- $constraint = find_type_constraint( $spec->{does} )
- || role_type( $spec->{does} );
- }
-
- $pv_spec{constraint} = $constraint;
-
- $pv_spec{callbacks} = {
- 'checking type constraint for '
- . $constraint->name => sub { $constraint->check( $_[0] ) }
- };
+ $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 {
Modified: branches/upstream/libmoosex-params-validate-perl/current/t/001_basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/t/001_basic.t?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/t/001_basic.t (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/t/001_basic.t Wed Jul 8 19:30:53 2009
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 33;
+use Test::More tests => 35;
use Test::Exception;
{
@@ -55,6 +55,21 @@
},
);
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};
}
}
@@ -156,3 +171,10 @@
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';
Modified: branches/upstream/libmoosex-params-validate-perl/current/t/005_coercion.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/t/005_coercion.t?rev=39509&op=diff
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/t/005_coercion.t (original)
+++ branches/upstream/libmoosex-params-validate-perl/current/t/005_coercion.t Wed Jul 8 19:30:53 2009
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 10;
use Test::Exception;
{
@@ -34,6 +34,18 @@
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 ];
}
@@ -81,3 +93,9 @@
throws_ok { $foo->baz( size1 => 30, size2 => 10, number => 'something' ) }
qr/\QThe 'number' parameter/,
'... the number param cannot be coerced';
+
+is_deeply(
+ $foo->quux( size2 => 4 ),
+ [ undef, 4, undef ],
+ '... does not try to coerce keys which are not provided'
+);
Added: branches/upstream/libmoosex-params-validate-perl/current/t/009_wrapped.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libmoosex-params-validate-perl/current/t/009_wrapped.t?rev=39509&op=file
==============================================================================
--- branches/upstream/libmoosex-params-validate-perl/current/t/009_wrapped.t (added)
+++ branches/upstream/libmoosex-params-validate-perl/current/t/009_wrapped.t Wed Jul 8 19:30:53 2009
@@ -1,0 +1,65 @@
+#!/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)' );
+}
+
More information about the Pkg-perl-cvs-commits
mailing list