Commit | Line | Data |
d9d1529d |
1 | package MooseX::Params::Validate; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Carp 'confess'; |
7 | use Devel::Caller 'caller_cv'; |
8 | use Scalar::Util 'blessed', 'refaddr'; |
9 | |
10 | use Moose::Util::TypeConstraints qw( find_type_constraint class_type role_type ); |
11 | use Params::Validate (); |
12 | use Sub::Exporter -setup => { |
13 | exports => [ |
14 | qw( validated_hash validated_list pos_validated_list validate validatep ) |
15 | ], |
16 | groups => { |
17 | default => [qw( validated_hash validated_list pos_validated_list )], |
18 | deprecated => [qw( validate validatep )], |
19 | }, |
20 | }; |
21 | |
382f6138 |
22 | our $VERSION = '0.14'; |
d9d1529d |
23 | our $AUTHORITY = 'cpan:STEVAN'; |
24 | |
25 | my %CACHED_SPECS; |
26 | |
27 | sub validated_hash { |
28 | my ( $args, %spec ) = @_; |
29 | |
30 | my $cache_key = _cache_key( \%spec ); |
31 | |
32 | if ( exists $CACHED_SPECS{$cache_key} ) { |
33 | ( ref $CACHED_SPECS{$cache_key} eq 'HASH' ) |
34 | || confess |
35 | "I was expecting a HASH-ref in the cached $cache_key parameter" |
36 | . " spec, you are doing something funky, stop it!"; |
37 | %spec = %{ $CACHED_SPECS{$cache_key} }; |
38 | } |
39 | else { |
40 | my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1; |
41 | |
42 | $spec{$_} = _convert_to_param_validate_spec( $spec{$_} ) |
43 | foreach keys %spec; |
44 | |
45 | $CACHED_SPECS{$cache_key} = \%spec |
46 | if $should_cache; |
47 | } |
48 | |
49 | my $instance; |
50 | $instance = shift @$args if blessed $args->[0]; |
51 | |
52 | my %args = @$args; |
53 | |
54 | $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} ) |
55 | for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec; |
56 | |
57 | %args = Params::Validate::validate_with( |
58 | params => \%args, |
59 | spec => \%spec, |
60 | called => _caller_name(), |
61 | ); |
62 | |
63 | return ( ( defined $instance ? $instance : () ), %args ); |
64 | } |
65 | |
66 | *validate = \&validated_hash; |
67 | |
68 | sub validated_list { |
69 | my ( $args, @spec ) = @_; |
70 | |
71 | my %spec = @spec; |
72 | |
73 | my $cache_key = _cache_key( \%spec ); |
74 | |
75 | my @ordered_spec; |
76 | if ( exists $CACHED_SPECS{$cache_key} ) { |
77 | ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' ) |
78 | || confess |
79 | "I was expecting a ARRAY-ref in the cached $cache_key parameter" |
80 | . " spec, you are doing something funky, stop it!"; |
81 | %spec = %{ $CACHED_SPECS{$cache_key}->[0] }; |
82 | @ordered_spec = @{ $CACHED_SPECS{$cache_key}->[1] }; |
83 | } |
84 | else { |
85 | my $should_cache = delete $spec{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1; |
86 | |
87 | @ordered_spec = grep { exists $spec{$_} } @spec; |
88 | |
89 | $spec{$_} = _convert_to_param_validate_spec( $spec{$_} ) |
90 | foreach keys %spec; |
91 | |
92 | $CACHED_SPECS{$cache_key} = [ \%spec, \@ordered_spec ] |
93 | if $should_cache; |
94 | } |
95 | |
96 | my $instance; |
97 | $instance = shift @$args if blessed $args->[0]; |
98 | |
99 | my %args = @$args; |
100 | |
101 | $args{$_} = $spec{$_}{constraint}->coerce( $args{$_} ) |
102 | for grep { $spec{$_}{coerce} && exists $args{$_} } keys %spec; |
103 | |
104 | %args = Params::Validate::validate_with( |
105 | params => \%args, |
106 | spec => \%spec, |
107 | called => _caller_name(), |
108 | ); |
109 | |
110 | return ( |
111 | ( defined $instance ? $instance : () ), |
112 | @args{@ordered_spec} |
113 | ); |
114 | } |
115 | |
116 | *validatep = \&validated_list; |
117 | |
118 | sub pos_validated_list { |
119 | my $args = shift; |
120 | |
121 | my @spec; |
122 | push @spec, shift while ref $_[0]; |
123 | |
124 | my %extra = @_; |
125 | |
126 | my $cache_key = _cache_key( \%extra ); |
127 | |
128 | my @pv_spec; |
129 | if ( exists $CACHED_SPECS{$cache_key} ) { |
130 | ( ref $CACHED_SPECS{$cache_key} eq 'ARRAY' ) |
131 | || confess |
132 | "I was expecting an ARRAY-ref in the cached $cache_key parameter" |
133 | . " spec, you are doing something funky, stop it!"; |
134 | @pv_spec = @{ $CACHED_SPECS{$cache_key} }; |
135 | } |
136 | else { |
137 | my $should_cache = exists $extra{MX_PARAMS_VALIDATE_NO_CACHE} ? 0 : 1; |
138 | |
139 | # prepare the parameters ... |
140 | @pv_spec = map { _convert_to_param_validate_spec($_) } @spec; |
141 | |
142 | $CACHED_SPECS{$cache_key} = \@pv_spec |
143 | if $should_cache; |
144 | } |
145 | |
146 | my @args = @{$args}; |
147 | |
148 | $args[$_] = $pv_spec[$_]{constraint}->coerce( $args[$_] ) |
149 | for grep { $pv_spec[$_] && $pv_spec[$_]{coerce} } 0 .. $#args; |
150 | |
151 | @args = Params::Validate::validate_with( |
152 | params => \@args, |
153 | spec => \@pv_spec, |
154 | called => _caller_name(), |
155 | ); |
156 | |
157 | return @args; |
158 | } |
159 | |
160 | sub _cache_key { |
161 | my $spec = shift; |
162 | |
163 | if ( exists $spec->{MX_PARAMS_VALIDATE_CACHE_KEY} ) { |
164 | return delete $spec->{MX_PARAMS_VALIDATE_CACHE_KEY}; |
165 | } |
166 | else { |
167 | return refaddr( caller_cv(2) ); |
168 | } |
169 | } |
170 | |
171 | sub _convert_to_param_validate_spec { |
172 | my ($spec) = @_; |
173 | my %pv_spec; |
174 | |
175 | $pv_spec{optional} = $spec->{optional} |
176 | if exists $spec->{optional}; |
177 | |
178 | $pv_spec{default} = $spec->{default} |
179 | if exists $spec->{default}; |
180 | |
181 | $pv_spec{coerce} = $spec->{coerce} |
182 | if exists $spec->{coerce}; |
183 | |
184 | my $constraint; |
185 | if ( defined $spec->{isa} ) { |
186 | $constraint |
187 | = _is_tc( $spec->{isa} ) |
188 | || Moose::Util::TypeConstraints::find_or_parse_type_constraint( |
189 | $spec->{isa} ) |
190 | || class_type( $spec->{isa} ); |
191 | } |
192 | elsif ( defined $spec->{does} ) { |
193 | $constraint |
194 | = _is_tc( $spec->{isa} ) |
195 | || find_type_constraint( $spec->{does} ) |
196 | || role_type( $spec->{does} ); |
197 | } |
198 | |
199 | $pv_spec{callbacks} = $spec->{callbacks} |
200 | if exists $spec->{callbacks}; |
201 | |
202 | if ($constraint) { |
203 | $pv_spec{constraint} = $constraint; |
204 | |
205 | $pv_spec{callbacks} |
206 | { 'checking type constraint for ' . $constraint->name } |
207 | = sub { $constraint->check( $_[0] ) }; |
208 | } |
209 | |
210 | delete $pv_spec{coerce} |
211 | unless $pv_spec{constraint} && $pv_spec{constraint}->has_coercion; |
212 | |
213 | return \%pv_spec; |
214 | } |
215 | |
216 | sub _is_tc { |
217 | my $maybe_tc = shift; |
218 | |
219 | return $maybe_tc |
220 | if defined $maybe_tc |
221 | && blessed $maybe_tc |
222 | && $maybe_tc->isa('Moose::Meta::TypeConstraint'); |
223 | } |
224 | |
225 | sub _caller_name { |
226 | my $depth = shift || 0; |
227 | |
228 | return ( caller( 2 + $depth ) )[3]; |
229 | } |
230 | |
231 | 1; |
232 | |
233 | __END__ |
234 | |
235 | =pod |
236 | |
237 | =head1 NAME |
238 | |
239 | MooseX::Params::Validate - an extension of Params::Validate for using Moose's types |
240 | |
241 | =head1 SYNOPSIS |
242 | |
243 | package Foo; |
244 | use Moose; |
245 | use MooseX::Params::Validate; |
246 | |
247 | sub foo { |
248 | my ( $self, %params ) = validated_hash( |
249 | \@_, |
250 | bar => { isa => 'Str', default => 'Moose' }, |
251 | ); |
252 | return "Horray for $params{bar}!"; |
253 | } |
254 | |
255 | sub bar { |
256 | my $self = shift; |
257 | my ( $foo, $baz, $gorch ) = validated_list( |
258 | \@_, |
259 | foo => { isa => 'Foo' }, |
260 | baz => { isa => 'ArrayRef | HashRef', optional => 1 }, |
261 | gorch => { isa => 'ArrayRef[Int]', optional => 1 } |
262 | ); |
263 | [ $foo, $baz, $gorch ]; |
264 | } |
265 | |
266 | =head1 DESCRIPTION |
267 | |
268 | This module fills a gap in Moose by adding method parameter validation |
269 | to Moose. This is just one of many developing options, it should not |
270 | be considered the "official" one by any means though. |
271 | |
272 | You might also want to explore C<MooseX::Method::Signatures> and |
273 | C<MooseX::Declare> |
274 | |
275 | =head1 CAVEATS |
276 | |
277 | It is not possible to introspect the method parameter specs, they are |
278 | created as needed when the method is called and cached for subsequent |
279 | calls. |
280 | |
281 | =head1 EXPORTS |
282 | |
283 | =over 4 |
284 | |
285 | =item B<validated_hash( \@_, %parameter_spec )> |
286 | |
287 | This behaves similar to the standard Params::Validate C<validate> |
288 | function and returns the captured values in a HASH. The one exception |
289 | being that if it spots an instance in the C<@_>, then it will handle |
290 | it appropriately (unlike Params::Validate which forces you to shift |
291 | you C<$self> first). |
292 | |
293 | The C<%parameter_spec> accepts the following options: |
294 | |
295 | =over 4 |
296 | |
297 | =item I<isa> |
298 | |
299 | The C<isa> option can be either; class name, Moose type constraint |
300 | name or an anon Moose type constraint. |
301 | |
302 | =item I<does> |
303 | |
304 | The C<does> option can be either; role name or an anon Moose type |
305 | constraint. |
306 | |
307 | =item I<default> |
308 | |
309 | This is the default value to be used if the value is not supplied. |
310 | |
311 | =item I<optional> |
312 | |
313 | As with Params::Validate, all options are considered required unless |
314 | otherwise specified. This option is passed directly to |
315 | Params::Validate. |
316 | |
317 | =item I<coerce> |
318 | |
319 | If this is true and the parameter has a type constraint which has |
320 | coercions, then the coercion will be called for this parameter. If the |
321 | type does have coercions, then this parameter is ignored. |
322 | |
323 | =back |
324 | |
325 | This function is also available under its old name, C<validate>. |
326 | |
327 | =item B<validated_list( \@_, %parameter_spec )> |
328 | |
329 | The C<%parameter_spec> accepts the same options as above, but returns |
330 | the parameters as positional values instead of a HASH. This is best |
331 | explained by example: |
332 | |
333 | sub foo { |
334 | my ( $self, $foo, $bar ) = validated_list( |
335 | \@_, |
336 | foo => { isa => 'Foo' }, |
337 | bar => { isa => 'Bar' }, |
338 | ); |
339 | $foo->baz($bar); |
340 | } |
341 | |
342 | We capture the order in which you defined the parameters and then |
343 | return them as a list in the same order. If a param is marked optional |
344 | and not included, then it will be set to C<undef>. |
345 | |
346 | Like C<validated_hash>, if it spots an object instance as the first |
347 | parameter of C<@_>, it will handle it appropriately, returning it as |
348 | the first argument. |
349 | |
350 | This function is also available under its old name, C<validatep>. |
351 | |
352 | =item B<pos_validated_list( \@_, $spec, $spec, ... )> |
353 | |
354 | This function validates a list of positional parameters. Each C<$spec> |
355 | should validate one of the parameters in the list: |
356 | |
357 | sub foo { |
358 | my $self = shift; |
359 | my ( $foo, $bar ) = pos_validated_list( |
360 | \@_, |
361 | { isa => 'Foo' }, |
362 | { isa => 'Bar' }, |
363 | ); |
364 | |
365 | ... |
366 | } |
367 | |
368 | Unlike the other functions, this function I<cannot> find C<$self> in |
369 | the argument list. Make sure to shift it off yourself before doing |
370 | validation. |
371 | |
372 | If a parameter is marked as optional and is not present, it will |
373 | simply not be returned. |
374 | |
375 | If you want to pass in any of the cache control parameters described |
376 | below, simply pass them after the list of parameter validation specs: |
377 | |
378 | sub foo { |
379 | my $self = shift; |
380 | my ( $foo, $bar ) = pos_validated_list( |
381 | \@_, |
382 | { isa => 'Foo' }, |
383 | { isa => 'Bar' }, |
384 | MX_PARAMS_VALIDATE_NO_CACHE => 1, |
385 | ); |
386 | |
387 | ... |
388 | } |
389 | |
390 | =back |
391 | |
392 | =head1 EXPORTS |
393 | |
394 | By default, this module exports the C<validated_hash>, |
395 | C<validated_list>, and C<pos_validated_list>. |
396 | |
397 | If you would prefer to import the now deprecated functions C<validate> |
398 | and C<validatep> instead, you can use the C<:deprecated> tag to import |
399 | them. |
400 | |
401 | =head1 IMPORTANT NOTE ON CACHING |
402 | |
403 | When C<validate> or C<validatep> are called the first time, the |
404 | parameter spec is prepared and cached to avoid unnecessary |
405 | regeneration. It uses the fully qualified name of the subroutine |
406 | (package + subname) as the cache key. In 99.999% of the use cases for |
407 | this module, that will be the right thing to do. |
408 | |
409 | However, I have (ab)used this module occasionally to handle dynamic |
410 | sets of parameters. In this special use case you can do a couple |
411 | things to better control the caching behavior. |
412 | |
413 | =over 4 |
414 | |
415 | =item * |
416 | |
417 | Passing in the C<MX_PARAMS_VALIDATE_NO_CACHE> flag in the parameter |
418 | spec this will prevent the parameter spec from being cached. |
419 | |
420 | sub foo { |
421 | my ( $self, %params ) = validated_hash( |
422 | \@_, |
423 | foo => { isa => 'Foo' }, |
424 | MX_PARAMS_VALIDATE_NO_CACHE => 1, |
425 | ); |
426 | |
427 | } |
428 | |
429 | =item * |
430 | |
431 | Passing in C<MX_PARAMS_VALIDATE_CACHE_KEY> with a value to be used as |
432 | the cache key will bypass the normal cache key generation. |
433 | |
434 | sub foo { |
435 | my ( $self, %params ) = validated_hash( |
436 | \@_, |
437 | foo => { isa => 'Foo' }, |
438 | MX_PARAMS_VALIDATE_CACHE_KEY => 'foo-42', |
439 | ); |
440 | |
441 | } |
442 | |
443 | =back |
444 | |
445 | =head1 BUGS |
446 | |
447 | All complex software has bugs lurking in it, and this module is no |
448 | exception. If you find a bug please either email me, or add the bug to |
449 | cpan-RT. |
450 | |
451 | =head1 AUTHORS |
452 | |
453 | Stevan Little E<lt>stevan.little@iinteractive.comE<gt> |
454 | |
455 | Dave Rolsky E<lt>autarch@urth.orgE<gt> |
456 | |
457 | =head1 COPYRIGHT AND LICENSE |
458 | |
459 | Copyright 2007-2009 by Infinity Interactive, Inc. |
460 | |
461 | L<http://www.iinteractive.com> |
462 | |
463 | This library is free software; you can redistribute it and/or modify |
464 | it under the same terms as Perl itself. |
465 | |
466 | =cut |