File Coverage

blib/lib/MouseX/Params/Validate.pm
Criterion Covered Total %
statement 26 113 23.0
branch 0 64 0.0
condition 0 23 0.0
subroutine 9 17 52.9
pod 3 3 100.0
total 38 220 17.2


line stmt bran cond sub pod time code
1             package MouseX::Params::Validate;
2              
3             $MouseX::Params::Validate::VERSION = '0.10';
4             $MouseX::Params::Validate::AUTHOR = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             MouseX::Params::Validate - Extension of Params::Validate using Mouse's types.
9              
10             =head1 VERSION
11              
12             Version 0.10
13              
14             =cut
15              
16 3     3   29871 use 5.006;
  3         13  
17 3     3   19 use strict; use warnings;
  3     3   4  
  3         80  
  3         15  
  3         23  
  3         111  
18              
19 3     3   15 use Carp 'confess';
  3         3  
  3         264  
20 3     3   2370 use Devel::Caller 'caller_cv';
  3         12885  
  3         268  
21 3     3   21 use Scalar::Util 'blessed', 'refaddr', 'reftype';
  3         5  
  3         417  
22              
23 3     3   2460 use Mouse::Util::TypeConstraints qw( find_type_constraint class_type role_type );
  3         65239  
  3         22  
24 3     3   2887 use Params::Validate;
  3         30184  
  3         321  
25 3         43 use Sub::Exporter -setup =>
26             {
27             exports => [qw( validated_hash validated_list pos_validated_list )],
28             groups => {default => [qw( validated_hash validated_list pos_validated_list )]},
29 3     3   1928 };
  3         41941  
30              
31             my %CACHED_SPECS;
32              
33             =head1 DESCRIPTION
34              
35             Method parameter validation extension to Mouse.
36              
37             Borrowed code entirely from L and stripped Moose footprints.
38              
39             =head1 EXPORTS
40              
41             By default, this module exports the following:
42              
43             =over 3
44              
45             =item * C
46              
47             =item * C
48              
49             =item * C
50              
51             =back
52              
53             =head1 CAVEATS
54              
55             It isn't possible to introspect the method parameter specs they are created as
56             needed when the method is called and cached for subsequent calls.
57              
58             =head1 CACHING
59              
60             When a validation subroutine is called the first time, the parameter spec is
61             prepared & cached to avoid unnecessary regeneration. It uses the fully qualified
62             name of the subroutine (package +subname) as the cache key. In 99.999% of the use
63             cases for this module that will be the right thing to do. You can do a couple
64             things to better control the caching behavior.
65              
66             =over 2
67              
68             =item *
69              
70             Passing in the C flag in the parameter spec this will
71             prevent the parameter spec from being cached.
72              
73             =item *
74              
75             Passing in C with value to be used as the cache key
76             will bypass the normal cache key generation.
77              
78             =back
79              
80             =head1 METHODS
81              
82             =head2 B
83              
84             This behaves similarly to the standard L C function
85             and returns the captured values in a HASH. The one exception is where if it spots
86             an instance in the C<@_> ,then it will handle it appropriately.
87              
88             The values in C<@_> can either be a set of name-value pairs or a single hash
89             reference.
90              
91             The C<%parameter_spec> accepts the following options:
92              
93             =over 4
94              
95             =item I
96              
97             The C option can be either;class name, Mouse type constraint name or an anon
98             Mouse type constraint.
99              
100             =item I
101              
102             The C option can be either; role name or an anon Mouse type constraint.
103              
104             =item I
105              
106             This is the default value to be used if the value is not supplied.
107              
108             =item I
109              
110             As with L, all options are considered required unless otherwise
111             specified. This option is passed directly to L.
112              
113             =item I
114              
115             If this is true and the parameter has a type constraint which has coercions, then
116             the coercion will be called for this parameter.If the type does have coercions,
117             then this parameter is ignored.
118              
119             =back
120              
121             use Mouse;
122             use MouseX::Params::Validate;
123              
124             sub foo
125             {
126             my ($self, %params) = validated_hash(
127             \@_,
128             bar => {isa => 'Str', default => 'Mouse'},
129             );
130             ...
131             ...
132             }
133              
134             =cut
135              
136             sub validated_hash
137             {
138 0     0 1   my ($args, %spec) = @_;
139              
140 0           my $cache_key = _cache_key(\%spec);
141 0           my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
142              
143 0 0         if (exists $CACHED_SPECS{$cache_key})
144             {
145 0 0         (ref($CACHED_SPECS{$cache_key}) eq 'HASH')
146             || confess("I was expecting a HASH-ref in the cached $cache_key parameter"
147             . " spec, you are doing something funky, stop it!");
148 0           %spec = %{$CACHED_SPECS{$cache_key}};
  0            
149             }
150             else
151             {
152 0 0         my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
153             $spec{$_} = _convert_to_param_validate_spec( $spec{$_} )
154 0           foreach keys %spec;
155 0 0         $CACHED_SPECS{$cache_key} = \%spec if $should_cache;
156             }
157              
158 0           my $instance;
159 0 0         $instance = shift @$args if blessed $args->[0];
160              
161             my %args
162             = @$args == 1
163             && ref $args->[0]
164 0 0 0       && reftype($args->[0]) eq 'HASH' ? %{$args->[0]} : @$args;
  0            
165              
166             $args{$_} = $spec{$_}{constraint}->coerce($args{$_})
167 0 0         for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
  0            
168              
169 0           %args = Params::Validate::validate_with(
170             params => \%args,
171             spec => \%spec,
172             allow_extra => $allow_extra,
173             called => _caller_name(),
174             );
175              
176 0 0         return ((defined $instance ? $instance : ()), %args);
177             }
178              
179             =head2 B
180              
181             The C<%parameter_spec> accepts the same options as above but returns the params
182             as positional values instead of a HASH.
183              
184             We capture the order in which you defined the parameters and then return them as
185             a list in the same order.If a param is marked optional and not included, then it
186             will be set to C.
187              
188             The values in C<@_> can either be a set of name-value pairs or a single hash
189             reference.
190              
191             Like C, if it spots an object instance as the first parameter of
192             C<@_> it will handle it appropriately, returning it as the first argument.
193              
194             use Mouse;
195             use MouseX::Params::Validate;
196              
197             sub foo
198             {
199             my ($self, $foo, $bar) = validated_list(
200             \@_,
201             foo => {isa => 'Foo'},
202             bar => {isa => 'Bar'},
203             );
204             ...
205             ...
206             }
207              
208             =cut
209              
210             sub validated_list
211             {
212 0     0 1   my ($args, @spec) = @_;
213              
214 0           my %spec = @spec;
215 0           my $cache_key = _cache_key(\%spec);
216 0           my $allow_extra = delete $spec{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
217              
218 0           my @ordered_spec;
219 0 0         if (exists $CACHED_SPECS{$cache_key})
220             {
221 0 0         (ref($CACHED_SPECS{$cache_key}) eq 'ARRAY')
222             || confess("I was expecting a ARRAY-ref in the cached $cache_key parameter"
223             . " spec, you are doing something funky, stop it!");
224 0           %spec = %{ $CACHED_SPECS{$cache_key}->[0] };
  0            
225 0           @ordered_spec = @{ $CACHED_SPECS{$cache_key}->[1] };
  0            
226             }
227             else
228             {
229 0 0         my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
230 0           @ordered_spec = grep { exists $spec{$_} } @spec;
  0            
231 0           $spec{$_} = _convert_to_param_validate_spec($spec{$_}) foreach keys %spec;
232 0 0         $CACHED_SPECS{$cache_key} = [\%spec, \@ordered_spec] if $should_cache;
233             }
234              
235 0           my $instance;
236 0 0         $instance = shift @$args if blessed $args->[0];
237              
238             my %args
239             = @$args == 1
240             && ref $args->[0]
241 0 0 0       && reftype( $args->[0] ) eq 'HASH' ? %{ $args->[0] } : @$args;
  0            
242              
243             $args{$_} = $spec{$_}{constraint}->coerce($args{$_})
244 0 0         for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec;
  0            
245              
246 0           %args = Params::Validate::validate_with(
247             params => \%args,
248             spec => \%spec,
249             allow_extra => $allow_extra,
250             called => _caller_name(),
251             );
252              
253             return (
254             (defined $instance ? $instance : ()),
255 0 0         @args{@ordered_spec}
256             );
257             }
258              
259             =head2 B
260              
261             This function validates a list of positional parameters. Each C<$spec> should
262             validate one of the parameters in the list.
263              
264             Unlike the other functions, this function I find C<$self> in the argument
265             list. Make sure to shift it off yourself before doing validation.
266              
267             The values in C<@_> must be a list of values. You cannot pass the values as an
268             array reference,because this cannot be distinguished from passing one value which
269             itself an array reference.
270              
271             If a parameter is marked as optional and is not present, it will simply not be
272             returned.
273              
274             If you want to pass in any of the cache control parameters described below,
275             simply pass them after the list of parameter validation specs.
276              
277             use Mouse;
278             use MouseX::Params::Validate;
279              
280             sub foo
281             {
282             my $self = shift;
283             my ($foo, $bar) = pos_validated_list(
284             \@_,
285             {isa => 'Foo'},
286             {isa => 'Bar'},
287             MX_PARAMS_VALIDATE_NO_CACHE => 1,
288             );
289             ...
290             ...
291             }
292              
293             =cut
294              
295             sub pos_validated_list
296             {
297 0     0 1   my $args = shift;
298              
299 0           my @spec;
300 0           push @spec, shift while ref $_[0];
301 0           my %extra = @_;
302 0           my $cache_key = _cache_key( \%extra );
303 0           my $allow_extra = delete $extra{MX_PARAMS_VALIDATE_ALLOW_EXTRA};
304              
305 0           my @pv_spec;
306 0 0         if (exists $CACHED_SPECS{$cache_key})
307             {
308 0 0         (ref($CACHED_SPECS{$cache_key}) eq 'ARRAY')
309             || confess("I was expecting an ARRAY-ref in the cached $cache_key parameter"
310             . " spec, you are doing something funky, stop it!");
311 0           @pv_spec = @{$CACHED_SPECS{$cache_key}};
  0            
312             }
313             else
314             {
315 0 0         my $should_cache = exists $extra{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1;
316 0           @pv_spec = map { _convert_to_param_validate_spec($_) } @spec;
  0            
317 0 0         $CACHED_SPECS{$cache_key} = \@pv_spec if $should_cache;
318             }
319              
320 0           my @args = @$args;
321             $args[$_] = $pv_spec[$_]{constraint}->coerce($args[$_])
322 0 0         for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args;
  0            
323              
324 0           @args = Params::Validate::validate_with(
325             params => \@args,
326             spec => \@pv_spec,
327             allow_extra => $allow_extra,
328             called => _caller_name(),
329             );
330              
331 0           return @args;
332             }
333              
334             sub _cache_key
335             {
336 0     0     my $spec = shift;
337              
338 0 0         if (exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY})
339             {
340 0           return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY};
341             }
342             else
343             {
344 0           return refaddr(caller_cv(2));
345             }
346             }
347              
348             sub _convert_to_param_validate_spec
349             {
350 0     0     my $spec = shift;
351 0           my %pv_spec;
352              
353             $pv_spec{optional} = $spec->{optional}
354 0 0         if exists $spec->{optional};
355             $pv_spec{default} = $spec->{default}
356 0 0         if exists $spec->{default};
357             $pv_spec{coerce} = $spec->{coerce}
358 0 0         if exists $spec->{coerce};
359             $pv_spec{depends} = $spec->{depends}
360 0 0         if exists $spec->{depends};
361              
362 0           my $constraint;
363 0 0         if (defined $spec->{isa})
    0          
364             {
365             $constraint = _is_tc($spec->{isa})
366             || Mouse::Util::TypeConstraints::find_or_parse_type_constraint($spec->{isa})
367 0   0       || class_type($spec->{isa});
368             }
369             elsif (defined $spec->{does})
370             {
371             $constraint = _is_tc($spec->{isa})
372             || find_type_constraint($spec->{does})
373 0   0       || role_type($spec->{does});
374             }
375              
376             $pv_spec{callbacks} = $spec->{callbacks}
377 0 0         if exists $spec->{callbacks};
378              
379 0 0         if ($constraint)
380             {
381 0           $pv_spec{constraint} = $constraint;
382             $pv_spec{callbacks}{'checking type constraint for ' . $constraint->name}
383 0     0     = sub { $constraint->check($_[0]) };
  0            
384             }
385              
386             delete $pv_spec{coerce}
387 0 0 0       unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion;
388              
389 0           return \%pv_spec;
390             }
391              
392             sub _is_tc
393             {
394 0     0     my $maybe_tc = shift;
395              
396 0 0 0       return $maybe_tc
      0        
397             if defined $maybe_tc
398             && blessed $maybe_tc
399             && $maybe_tc->isa('Mouse::Meta::TypeConstraint');
400             }
401              
402             sub _caller_name
403             {
404 0   0 0     my $depth = shift || 0;
405 0           return (caller(2 + $depth))[3];
406             }
407              
408             =head1 AUTHOR
409              
410             Mohammad S Anwar, C<< >>
411              
412             =head1 REPOSITORY
413              
414             L
415              
416             =head1 CONTRIBUTORS
417              
418             Hans Staugaard (STAUGAARD)
419              
420             =head1 BUGS
421              
422             Please report any bugs or feature requests to C
423             rt.cpan.org>, or through the web interface at L.
424             I will be notified and then you'll automatically be notified of progress on your
425             bug as I make changes.
426              
427             =head1 SUPPORT
428              
429             You can find documentation for this module with the perldoc command.
430              
431             perldoc MouseX::Params::Validate
432              
433             You can also look for information at:
434              
435             =over 4
436              
437             =item * RT: CPAN's request tracker
438              
439             L
440              
441             =item * AnnoCPAN: Annotated CPAN documentation
442              
443             L
444              
445             =item * CPAN Ratings
446              
447             L
448              
449             =item * Search CPAN
450              
451             L
452              
453             =back
454              
455             =head1 ACKNOWLEDGEMENTS
456              
457             =over 2
458              
459             =item * Stevan Little (Author of L).
460              
461             =item * Dave Rolsky Eautarch@urth.orgE (Maintainer of L).
462              
463             =back
464              
465             =head1 LICENSE AND COPYRIGHT
466              
467             Copyright (C) 2011 - 2016 Mohammad S Anwar.
468              
469             This program is free software; you can redistribute it and/or modify it under
470             the terms of the the Artistic License (2.0). You may obtain a copy of the full
471             license at:
472              
473             L
474              
475             Any use, modification, and distribution of the Standard or Modified Versions is
476             governed by this Artistic License.By using, modifying or distributing the Package,
477             you accept this license. Do not use, modify, or distribute the Package, if you do
478             not accept this license.
479              
480             If your Modified Version has been derived from a Modified Version made by someone
481             other than you,you are nevertheless required to ensure that your Modified Version
482             complies with the requirements of this license.
483              
484             This license does not grant you the right to use any trademark, service mark,
485             tradename, or logo of the Copyright Holder.
486              
487             This license includes the non-exclusive, worldwide, free-of-charge patent license
488             to make, have made, use, offer to sell, sell, import and otherwise transfer the
489             Package with respect to any patent claims licensable by the Copyright Holder that
490             are necessarily infringed by the Package. If you institute patent litigation
491             (including a cross-claim or counterclaim) against any party alleging that the
492             Package constitutes direct or contributory patent infringement,then this Artistic
493             License to you shall terminate on the date that such litigation is filed.
494              
495             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
496             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
497             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
498             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
499             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
500             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
501             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
502              
503             =cut
504              
505             1; # End of MouseX::Params::Validate