File Coverage

blib/lib/MooseX/Params/Validate.pm
Criterion Covered Total %
statement 126 126 100.0
branch 56 66 84.8
condition 13 23 56.5
subroutine 20 20 100.0
pod 3 3 100.0
total 218 238 91.6


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