File Coverage

blib/lib/MooseX/Params/Validate.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package MooseX::Params::Validate;
2             # git description: v0.19-5-g4255f1b
3              
4             $MooseX::Params::Validate::VERSION = '0.20'; # TRIAL
5 5     5   77207 use strict;
  5         11  
  5         176  
6 5     5   20 use warnings;
  5         6  
  5         132  
7              
8 5     5   19 use Carp 'confess';
  5         5  
  5         238  
9 5     5   2180 use Devel::Caller 'caller_cv';
  5         12685  
  5         375  
10 5     5   31 use Scalar::Util 'blessed', 'refaddr', 'reftype';
  5         7  
  5         556  
11              
12 5     5   3356 use Moose 2.1200 ();
  0            
  0            
13             use Moose::Util qw( throw_exception );
14             use Moose::Util::TypeConstraints
15             qw( find_type_constraint class_type role_type );
16             use MooseX::Params::Validate::Exception::ValidationFailedForTypeConstraint;
17             use Params::Validate 1.15 ();
18              
19             use Sub::Exporter -setup => {
20             exports => [
21             qw( validated_hash validated_list pos_validated_list validate validatep )
22             ],
23             groups => {
24             default => [qw( validated_hash validated_list pos_validated_list )],
25             deprecated => [qw( validate validatep )],
26             },
27             };
28              
29             my %CACHED_SPECS;
30              
31             sub validated_hash {
32             my ( $args, %spec ) = @_;
33              
34             my $cache_key = _cache_key( \%spec );
35              
36             my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
37              
38             if ( exists $CACHED_SPECS{$cache_key} ) {
39             ( ref $CACHED_SPECS{$cache_key} eq 'HASH' )
40             || confess
41             "I was expecting a HASH-ref in the cached $cache_key parameter"
42             . " spec, you are doing something funky, stop it!";
43             %spec = %{ $CACHED_SPECS{$cache_key} };
44             }
45             else {
46             my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
47              
48             $spec{$_} = _convert_to_param_validate_spec(
49             $spec{$_},
50             "The '$_' parameter",
51             ) foreach keys %spec;
52              
53             $CACHED_SPECS{$cache_key} = \%spec
54             if $should_cache;
55             }
56              
57             my $instance;
58             $instance = shift @$args if blessed $args->[0];
59              
60             my %args
61             = @$args == 1
62             && ref $args->[0]
63             && reftype( $args->[0] ) eq 'HASH' ? %{ $args->[0] } : @$args;
64              
65             $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
66             for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
67              
68             %args = Params::Validate::validate_with(
69             params => \%args,
70             spec => \%spec,
71             allow_extra => $allow_extra,
72             called => _caller_name(),
73             );
74              
75             return ( ( defined $instance ? $instance : () ), %args );
76             }
77              
78             *validate = \&validated_hash;
79              
80             sub validated_list {
81             my ( $args, @spec ) = @_;
82              
83             my %spec = @spec;
84              
85             my $cache_key = _cache_key( \%spec );
86              
87             my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
88              
89             my @ordered_spec;
90             if ( exists $CACHED_SPECS{$cache_key} ) {
91             ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
92             || confess
93             "I was expecting a ARRAY-ref in the cached $cache_key parameter"
94             . " spec, you are doing something funky, stop it!";
95             %spec = %{ $CACHED_SPECS{$cache_key}->[0] };
96             @ordered_spec = @{ $CACHED_SPECS{$cache_key}->[1] };
97             }
98             else {
99             my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
100              
101             @ordered_spec = grep { exists $spec{$_} } @spec;
102              
103             $spec{$_} = _convert_to_param_validate_spec(
104             $spec{$_},
105             "The '$_' parameter",
106             ) foreach keys %spec;
107              
108             $CACHED_SPECS{$cache_key} = [ \%spec, \@ordered_spec ]
109             if $should_cache;
110             }
111              
112             my $instance;
113             $instance = shift @$args if blessed $args->[0];
114              
115             my %args
116             = @$args == 1
117             && ref $args->[0]
118             && reftype( $args->[0] ) eq 'HASH' ? %{ $args->[0] } : @$args;
119              
120             $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} )
121             for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
122              
123             %args = Params::Validate::validate_with(
124             params => \%args,
125             spec => \%spec,
126             allow_extra => $allow_extra,
127             called => _caller_name(),
128             );
129              
130             return (
131             ( defined $instance ? $instance : () ),
132             @args{@ordered_spec}
133             );
134             }
135              
136             *validatep = \&validated_list;
137              
138             sub pos_validated_list {
139             my $args = shift;
140              
141             my @spec;
142             push @spec, shift while ref $_[0];
143              
144             my %extra = @_;
145              
146             my $cache_key = _cache_key( \%extra );
147              
148             my $allow_extra = delete $extra{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
149              
150             my @pv_spec;
151             if ( exists $CACHED_SPECS{$cache_key} ) {
152             ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' )
153             || confess
154             "I was expecting an ARRAY-ref in the cached $cache_key parameter"
155             . " spec, you are doing something funky, stop it!";
156             @pv_spec = @{ $CACHED_SPECS{$cache_key} };
157             }
158             else {
159             my $should_cache = exists $extra{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
160              
161             @pv_spec = map {
162             _convert_to_param_validate_spec(
163             $spec[$_],
164             'Parameter #' . ( $_ + 1 )
165             )
166             } 0 .. $#spec;
167              
168             $CACHED_SPECS{$cache_key} = \@pv_spec
169             if $should_cache;
170             }
171              
172             my @args = @$args;
173              
174             $args[$_] = $pv_spec[$_]{constraint}->coerce( $args[$_] )
175             for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
176              
177             @args = Params::Validate::validate_with(
178             params => \@args,
179             spec => \@pv_spec,
180             allow_extra => $allow_extra,
181             called => _caller_name(),
182             );
183              
184             return @args;
185             }
186              
187             sub _cache_key {
188             my $spec = shift;
189              
190             if ( exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY} ) {
191             return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
192             }
193             else {
194             return refaddr( caller_cv(2) );
195             }
196             }
197              
198             sub _convert_to_param_validate_spec {
199             my $spec = shift;
200             my $id = shift;
201              
202             my %pv_spec;
203              
204             $pv_spec{optional} = $spec->{optional}
205             if exists $spec->{optional};
206              
207             $pv_spec{default} = $spec->{default}
208             if exists $spec->{default};
209              
210             $pv_spec{coerce} = $spec->{coerce}
211             if exists $spec->{coerce};
212              
213             $pv_spec{depends} = $spec->{depends}
214             if exists $spec->{depends};
215              
216             my $constraint;
217             if ( defined $spec->{isa} ) {
218             $constraint
219             = _is_tc( $spec->{isa} )
220             || Moose::Util::TypeConstraints::find_or_parse_type_constraint(
221             $spec->{isa} )
222             || class_type( $spec->{isa} );
223             }
224             elsif ( defined $spec->{does} ) {
225             $constraint
226             = _is_tc( $spec->{isa} )
227             || find_type_constraint( $spec->{does} )
228             || role_type( $spec->{does} );
229             }
230              
231             $pv_spec{callbacks} = $spec->{callbacks}
232             if exists $spec->{callbacks};
233              
234             if ($constraint) {
235             $pv_spec{constraint} = $constraint;
236              
237             my $cb = sub {
238             return 1 if $constraint->check( $_[0] );
239             die MooseX::Params::Validate::Exception::ValidationFailedForTypeConstraint->new(
240             parameter => $id,
241             type => $constraint,
242             value => $_[0],
243             );
244             };
245              
246             $pv_spec{callbacks}
247             { 'checking type constraint for ' . $constraint->name } = $cb;
248             }
249              
250             delete $pv_spec{coerce}
251             unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion;
252              
253             return \%pv_spec;
254             }
255              
256             sub _is_tc {
257             my $maybe_tc = shift;
258              
259             return $maybe_tc
260             if defined $maybe_tc
261             && blessed $maybe_tc
262             && $maybe_tc->isa('Moose::Meta::TypeConstraint');
263             }
264              
265             sub _caller_name {
266             my $depth = shift || 0;
267              
268             return ( caller( 2 + $depth ) )[3];
269             }
270              
271             1;
272              
273             # ABSTRACT: an extension of Params::Validate using Moose's types
274              
275             __END__
276              
277             =pod
278              
279             =head1 NAME
280              
281             MooseX::Params::Validate - an extension of Params::Validate using Moose's types
282              
283             =head1 VERSION
284              
285             version 0.20
286              
287             =head1 SYNOPSIS
288              
289             package Foo;
290             use Moose;
291             use MooseX::Params::Validate;
292              
293             sub foo {
294             my ( $self, %params ) = validated_hash(
295             \@_,
296             bar => { isa => 'Str', default => 'Moose' },
297             );
298             return "Hooray for $params{bar}!";
299             }
300              
301             sub bar {
302             my $self = shift;
303             my ( $foo, $baz, $gorch ) = validated_list(
304             \@_,
305             foo => { isa => 'Foo' },
306             baz => { isa => 'ArrayRef | HashRef', optional => 1 },
307             gorch => { isa => 'ArrayRef[Int]', optional => 1 }
308             );
309             [ $foo, $baz, $gorch ];
310             }
311              
312             =head1 DESCRIPTION
313              
314             This module fills a gap in Moose by adding method parameter validation
315             to Moose. This is just one of many developing options, it should not
316             be considered the "official" one by any means though.
317              
318             You might also want to explore C<MooseX::Method::Signatures> and
319             C<MooseX::Declare>.
320              
321             =encoding UTF-8
322              
323             =head1 CAVEATS
324              
325             It is not possible to introspect the method parameter specs; they are
326             created as needed when the method is called and cached for subsequent
327             calls.
328              
329             =head1 EXPORTS
330              
331             =over 4
332              
333             =item B<validated_hash( \@_, %parameter_spec )>
334              
335             This behaves similarly to the standard Params::Validate C<validate>
336             function and returns the captured values in a HASH. The one exception
337             is where if it spots an instance in the C<@_>, then it will handle
338             it appropriately (unlike Params::Validate which forces you to shift
339             you C<$self> first).
340              
341             The values in C<@_> can either be a set of name-value pairs or a single hash
342             reference.
343              
344             The C<%parameter_spec> accepts the following options:
345              
346             =over 4
347              
348             =item I<isa>
349              
350             The C<isa> option can be either; class name, Moose type constraint
351             name or an anon Moose type constraint.
352              
353             =item I<does>
354              
355             The C<does> option can be either; role name or an anon Moose type
356             constraint.
357              
358             =item I<default>
359              
360             This is the default value to be used if the value is not supplied.
361              
362             =item I<optional>
363              
364             As with Params::Validate, all options are considered required unless
365             otherwise specified. This option is passed directly to
366             Params::Validate.
367              
368             =item I<coerce>
369              
370             If this is true and the parameter has a type constraint which has
371             coercions, then the coercion will be called for this parameter. If the
372             type does have coercions, then this parameter is ignored.
373              
374             =item I<depends>
375              
376             Another parameter that this one depends on. See the L<Params::Validate>
377             documentation for more details.
378              
379             =back
380              
381             This function is also available under its old name, C<validate>.
382              
383             =item B<validated_list( \@_, %parameter_spec )>
384              
385             The C<%parameter_spec> accepts the same options as above, but returns
386             the parameters as positional values instead of a HASH. This is best
387             explained by example:
388              
389             sub foo {
390             my ( $self, $foo, $bar ) = validated_list(
391             \@_,
392             foo => { isa => 'Foo' },
393             bar => { isa => 'Bar' },
394             );
395             $foo->baz($bar);
396             }
397              
398             We capture the order in which you defined the parameters and then
399             return them as a list in the same order. If a param is marked optional
400             and not included, then it will be set to C<undef>.
401              
402             The values in C<@_> can either be a set of name-value pairs or a single hash
403             reference.
404              
405             Like C<validated_hash>, if it spots an object instance as the first
406             parameter of C<@_>, it will handle it appropriately, returning it as
407             the first argument.
408              
409             This function is also available under its old name, C<validatep>.
410              
411             =item B<pos_validated_list( \@_, $spec, $spec, ... )>
412              
413             This function validates a list of positional parameters. Each C<$spec>
414             should validate one of the parameters in the list:
415              
416             sub foo {
417             my $self = shift;
418             my ( $foo, $bar ) = pos_validated_list(
419             \@_,
420             { isa => 'Foo' },
421             { isa => 'Bar' },
422             );
423              
424             ...
425             }
426              
427             Unlike the other functions, this function I<cannot> find C<$self> in
428             the argument list. Make sure to shift it off yourself before doing
429             validation.
430              
431             The values in C<@_> must be a list of values. You cannot pass the values as an
432             array reference, because this cannot be distinguished from passing one value
433             which is itself an array reference.
434              
435             If a parameter is marked as optional and is not present, it will
436             simply not be returned.
437              
438             If you want to pass in any of the cache control parameters described
439             below, simply pass them after the list of parameter validation specs:
440              
441             sub foo {
442             my $self = shift;
443             my ( $foo, $bar ) = pos_validated_list(
444             \@_,
445             { isa => 'Foo' },
446             { isa => 'Bar' },
447             MX_PARAMS_VALIDATE_NO_CACHE => 1,
448             );
449              
450             ...
451             }
452              
453             =back
454              
455             =head1 EXCEPTION FOR FAILED VALIDATION
456              
457             If a type constraint check for a parameter fails, then the error is thrown as
458             a L<MooseX::Params::Validate::Exception::ValidationFailedForTypeConstraint>
459             object. When stringified, this object will use the error message generated by
460             the type constraint that failed.
461              
462             Other errors are simply percolated up from L<Params::Validate> as-is, and are
463             not turned into exception objects. This may change in the future (or more
464             likely, L<Params::Validate> may start throwing objects of its own).
465              
466             =head1 ALLOWING EXTRA PARAMETERS
467              
468             By default, any parameters not mentioned in the parameter spec cause this
469             module to throw an error. However, you can have this module simply ignore them
470             by setting C<MX_PARAMS_VALIDATE_ALLOW_EXTRA> to a true value when calling a
471             validation subroutine.
472              
473             When calling C<validated_hash> or C<pos_validated_list> the extra parameters
474             are simply returned in the hash or list as appropriate. However, when you call
475             C<validated_list> the extra parameters will not be returned at all. You can
476             get them by looking at the original value of C<@_>.
477              
478             =head1 EXPORTS
479              
480             By default, this module exports the C<validated_hash>,
481             C<validated_list>, and C<pos_validated_list>.
482              
483             If you would prefer to import the now deprecated functions C<validate>
484             and C<validatep> instead, you can use the C<:deprecated> tag to import
485             them.
486              
487             =head1 IMPORTANT NOTE ON CACHING
488              
489             When a validation subroutine is called the first time, the parameter spec is
490             prepared and cached to avoid unnecessary regeneration. It uses the fully
491             qualified name of the subroutine (package + subname) as the cache key. In
492             99.999% of the use cases for this module, that will be the right thing to do.
493              
494             However, I have (ab)used this module occasionally to handle dynamic
495             sets of parameters. In this special use case you can do a couple
496             things to better control the caching behavior.
497              
498             =over 4
499              
500             =item *
501              
502             Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter
503             spec this will prevent the parameter spec from being cached.
504              
505             sub foo {
506             my ( $self, %params ) = validated_hash(
507             \@_,
508             foo => { isa => 'Foo' },
509             MX_PARAMS_VALIDATE_NO_CACHE => 1,
510             );
511              
512             }
513              
514             =item *
515              
516             Passing in C<MX_PARAMS_VALIDATE_CACHE_KEY> with a value to be used as
517             the cache key will bypass the normal cache key generation.
518              
519             sub foo {
520             my ( $self, %params ) = validated_hash(
521             \@_,
522             foo => { isa => 'Foo' },
523             MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42',
524             );
525              
526             }
527              
528             =back
529              
530             =head1 MAINTAINER
531              
532             Dave Rolsky E<lt>autarch@urth.orgE<gt>
533              
534             =head1 BUGS
535              
536             Please submit bugs to the CPAN RT system at
537             http://rt.cpan.org/NoAuth/ReportBug.html?Queue=moosex-params-validate or via
538             email at bug-moosex-params-validate@rt.cpan.org.
539              
540             =head1 AUTHORS
541              
542             =over 4
543              
544             =item *
545              
546             Stevan Little <stevan.little@iinteractive.com>
547              
548             =item *
549              
550             Dave Rolsky <autarch@urth.org>
551              
552             =back
553              
554             =head1 CONTRIBUTORS
555              
556             =for stopwords Dagfinn Ilmari MannsÃ¥ker Hans Staugaard Karen Etheridge
557              
558             =over 4
559              
560             =item *
561              
562             Dagfinn Ilmari MannsÃ¥ker <ilmari@ilmari.org>
563              
564             =item *
565              
566             Hans Staugaard <h.staugaard@tweakker.com>
567              
568             =item *
569              
570             Karen Etheridge <ether@cpan.org>
571              
572             =back
573              
574             =head1 COPYRIGHT AND LICENSE
575              
576             This software is copyright (c) 2013 - 2015 by Stevan Little <stevan.little@iinteractive.com>.
577              
578             This is free software; you can redistribute it and/or modify it under
579             the same terms as the Perl 5 programming language system itself.
580              
581             =cut