Commit | Line | Data |
---|---|---|
703d525d JB |
1 | package Params::Check; |
2 | ||
3 | use strict; | |
4 | ||
5 | use Carp qw[carp croak]; | |
6 | use Locale::Maketext::Simple Style => 'gettext'; | |
7 | ||
8 | use Data::Dumper; | |
9 | ||
10 | BEGIN { | |
11 | use Exporter (); | |
12 | use vars qw[ @ISA $VERSION @EXPORT_OK $VERBOSE $ALLOW_UNKNOWN | |
13 | $STRICT_TYPE $STRIP_LEADING_DASHES $NO_DUPLICATES | |
14 | $PRESERVE_CASE $ONLY_ALLOW_DEFINED $WARNINGS_FATAL | |
7720784c | 15 | $SANITY_CHECK_TEMPLATE $CALLER_DEPTH $_ERROR_STRING |
703d525d JB |
16 | ]; |
17 | ||
18 | @ISA = qw[ Exporter ]; | |
19 | @EXPORT_OK = qw[check allow last_error]; | |
20 | ||
7720784c | 21 | $VERSION = '0.26'; |
703d525d JB |
22 | $VERBOSE = $^W ? 1 : 0; |
23 | $NO_DUPLICATES = 0; | |
24 | $STRIP_LEADING_DASHES = 0; | |
25 | $STRICT_TYPE = 0; | |
26 | $ALLOW_UNKNOWN = 0; | |
27 | $PRESERVE_CASE = 0; | |
28 | $ONLY_ALLOW_DEFINED = 0; | |
29 | $SANITY_CHECK_TEMPLATE = 1; | |
30 | $WARNINGS_FATAL = 0; | |
31 | $CALLER_DEPTH = 0; | |
32 | } | |
33 | ||
34 | my %known_keys = map { $_ => 1 } | |
35 | qw| required allow default strict_type no_override | |
36 | store defined |; | |
37 | ||
38 | =pod | |
39 | ||
40 | =head1 NAME | |
41 | ||
42 | Params::Check - A generic input parsing/checking mechanism. | |
43 | ||
44 | =head1 SYNOPSIS | |
45 | ||
46 | use Params::Check qw[check allow last_error]; | |
47 | ||
48 | sub fill_personal_info { | |
49 | my %hash = @_; | |
50 | my $x; | |
51 | ||
52 | my $tmpl = { | |
53 | firstname => { required => 1, defined => 1 }, | |
54 | lastname => { required => 1, store => \$x }, | |
55 | gender => { required => 1, | |
56 | allow => [qr/M/i, qr/F/i], | |
57 | }, | |
58 | married => { allow => [0,1] }, | |
59 | age => { default => 21, | |
60 | allow => qr/^\d+$/, | |
61 | }, | |
62 | ||
63 | phone => { allow => [ sub { return 1 if /$valid_re/ }, | |
64 | '1-800-PERL' ] | |
65 | }, | |
66 | id_list => { default => [], | |
67 | strict_type => 1 | |
68 | }, | |
69 | employer => { default => 'NSA', no_override => 1 }, | |
70 | }; | |
71 | ||
72 | ### check() returns a hashref of parsed args on success ### | |
73 | my $parsed_args = check( $tmpl, \%hash, $VERBOSE ) | |
74 | or die qw[Could not parse arguments!]; | |
75 | ||
76 | ... other code here ... | |
77 | } | |
78 | ||
79 | my $ok = allow( $colour, [qw|blue green yellow|] ); | |
80 | ||
81 | my $error = Params::Check::last_error(); | |
82 | ||
83 | ||
84 | =head1 DESCRIPTION | |
85 | ||
86 | Params::Check is a generic input parsing/checking mechanism. | |
87 | ||
88 | It allows you to validate input via a template. The only requirement | |
89 | is that the arguments must be named. | |
90 | ||
91 | Params::Check can do the following things for you: | |
92 | ||
93 | =over 4 | |
94 | ||
95 | =item * | |
96 | ||
97 | Convert all keys to lowercase | |
98 | ||
99 | =item * | |
100 | ||
101 | Check if all required arguments have been provided | |
102 | ||
103 | =item * | |
104 | ||
105 | Set arguments that have not been provided to the default | |
106 | ||
107 | =item * | |
108 | ||
109 | Weed out arguments that are not supported and warn about them to the | |
110 | user | |
111 | ||
112 | =item * | |
113 | ||
114 | Validate the arguments given by the user based on strings, regexes, | |
115 | lists or even subroutines | |
116 | ||
117 | =item * | |
118 | ||
119 | Enforce type integrity if required | |
120 | ||
121 | =back | |
122 | ||
123 | Most of Params::Check's power comes from its template, which we'll | |
124 | discuss below: | |
125 | ||
126 | =head1 Template | |
127 | ||
128 | As you can see in the synopsis, based on your template, the arguments | |
129 | provided will be validated. | |
130 | ||
131 | The template can take a different set of rules per key that is used. | |
132 | ||
133 | The following rules are available: | |
134 | ||
135 | =over 4 | |
136 | ||
137 | =item default | |
138 | ||
139 | This is the default value if none was provided by the user. | |
140 | This is also the type C<strict_type> will look at when checking type | |
141 | integrity (see below). | |
142 | ||
143 | =item required | |
144 | ||
145 | A boolean flag that indicates if this argument was a required | |
146 | argument. If marked as required and not provided, check() will fail. | |
147 | ||
148 | =item strict_type | |
149 | ||
150 | This does a C<ref()> check on the argument provided. The C<ref> of the | |
151 | argument must be the same as the C<ref> of the default value for this | |
152 | check to pass. | |
153 | ||
154 | This is very useful if you insist on taking an array reference as | |
155 | argument for example. | |
156 | ||
157 | =item defined | |
158 | ||
159 | If this template key is true, enforces that if this key is provided by | |
160 | user input, its value is C<defined>. This just means that the user is | |
161 | not allowed to pass C<undef> as a value for this key and is equivalent | |
162 | to: | |
163 | allow => sub { defined $_[0] && OTHER TESTS } | |
164 | ||
165 | =item no_override | |
166 | ||
167 | This allows you to specify C<constants> in your template. ie, they | |
168 | keys that are not allowed to be altered by the user. It pretty much | |
169 | allows you to keep all your C<configurable> data in one place; the | |
170 | C<Params::Check> template. | |
171 | ||
172 | =item store | |
173 | ||
174 | This allows you to pass a reference to a scalar, in which the data | |
175 | will be stored: | |
176 | ||
177 | my $x; | |
178 | my $args = check(foo => { default => 1, store => \$x }, $input); | |
179 | ||
180 | This is basically shorthand for saying: | |
181 | ||
182 | my $args = check( { foo => { default => 1 }, $input ); | |
183 | my $x = $args->{foo}; | |
184 | ||
185 | You can alter the global variable $Params::Check::NO_DUPLICATES to | |
186 | control whether the C<store>'d key will still be present in your | |
187 | result set. See the L<Global Variables> section below. | |
188 | ||
189 | =item allow | |
190 | ||
191 | A set of criteria used to validate a particular piece of data if it | |
192 | has to adhere to particular rules. | |
193 | ||
194 | See the C<allow()> function for details. | |
195 | ||
196 | =back | |
197 | ||
198 | =head1 Functions | |
199 | ||
200 | =head2 check( \%tmpl, \%args, [$verbose] ); | |
201 | ||
202 | This function is not exported by default, so you'll have to ask for it | |
203 | via: | |
204 | ||
205 | use Params::Check qw[check]; | |
206 | ||
207 | or use its fully qualified name instead. | |
208 | ||
209 | C<check> takes a list of arguments, as follows: | |
210 | ||
211 | =over 4 | |
212 | ||
213 | =item Template | |
214 | ||
215 | This is a hashreference which contains a template as explained in the | |
216 | C<SYNOPSIS> and C<Template> section. | |
217 | ||
218 | =item Arguments | |
219 | ||
220 | This is a reference to a hash of named arguments which need checking. | |
221 | ||
222 | =item Verbose | |
223 | ||
224 | A boolean to indicate whether C<check> should be verbose and warn | |
225 | about what went wrong in a check or not. | |
226 | ||
227 | You can enable this program wide by setting the package variable | |
228 | C<$Params::Check::VERBOSE> to a true value. For details, see the | |
229 | section on C<Global Variables> below. | |
230 | ||
231 | =back | |
232 | ||
233 | C<check> will return when it fails, or a hashref with lowercase | |
234 | keys of parsed arguments when it succeeds. | |
235 | ||
236 | So a typical call to check would look like this: | |
237 | ||
238 | my $parsed = check( \%template, \%arguments, $VERBOSE ) | |
239 | or warn q[Arguments could not be parsed!]; | |
240 | ||
241 | A lot of the behaviour of C<check()> can be altered by setting | |
242 | package variables. See the section on C<Global Variables> for details | |
243 | on this. | |
244 | ||
245 | =cut | |
246 | ||
247 | sub check { | |
248 | my ($utmpl, $href, $verbose) = @_; | |
249 | ||
250 | ### did we get the arguments we need? ### | |
251 | return if !$utmpl or !$href; | |
252 | ||
253 | ### sensible defaults ### | |
254 | $verbose ||= $VERBOSE || 0; | |
255 | ||
256 | ### clear the current error string ### | |
257 | _clear_error(); | |
258 | ||
259 | ### XXX what type of template is it? ### | |
260 | ### { key => { } } ? | |
261 | #if (ref $args eq 'HASH') { | |
262 | # 1; | |
263 | #} | |
264 | ||
265 | ### clean up the template ### | |
266 | my $args = _clean_up_args( $href ) or return; | |
267 | ||
268 | ### sanity check + defaults + required keys set? ### | |
269 | my $defs = _sanity_check_and_defaults( $utmpl, $args, $verbose ) | |
270 | or return; | |
271 | ||
272 | ### deref only once ### | |
273 | my %utmpl = %$utmpl; | |
274 | my %args = %$args; | |
275 | my %defs = %$defs; | |
276 | ||
277 | ### flag to see if anything went wrong ### | |
278 | my $wrong; | |
279 | ||
280 | ### flag to see if we warned for anything, needed for warnings_fatal | |
281 | my $warned; | |
282 | ||
283 | for my $key (keys %args) { | |
284 | ||
285 | ### you gave us this key, but it's not in the template ### | |
286 | unless( $utmpl{$key} ) { | |
287 | ||
288 | ### but we'll allow it anyway ### | |
289 | if( $ALLOW_UNKNOWN ) { | |
290 | $defs{$key} = $args{$key}; | |
291 | ||
292 | ### warn about the error ### | |
293 | } else { | |
294 | _store_error( | |
295 | loc("Key '%1' is not a valid key for %2 provided by %3", | |
296 | $key, _who_was_it(), _who_was_it(1)), $verbose); | |
297 | $warned ||= 1; | |
298 | } | |
299 | next; | |
300 | } | |
301 | ||
302 | ### check if you're even allowed to override this key ### | |
303 | if( $utmpl{$key}->{'no_override'} ) { | |
304 | _store_error( | |
305 | loc(q[You are not allowed to override key '%1']. | |
306 | q[for %2 from %3], $key, _who_was_it(), _who_was_it(1)), | |
307 | $verbose | |
308 | ); | |
309 | $warned ||= 1; | |
310 | next; | |
311 | } | |
312 | ||
313 | ### copy of this keys template instructions, to save derefs ### | |
314 | my %tmpl = %{$utmpl{$key}}; | |
315 | ||
316 | ### check if you were supposed to provide defined() values ### | |
317 | if( ($tmpl{'defined'} || $ONLY_ALLOW_DEFINED) and | |
318 | not defined $args{$key} | |
319 | ) { | |
320 | _store_error(loc(q|Key '%1' must be defined when passed|, $key), | |
321 | $verbose ); | |
322 | $wrong ||= 1; | |
323 | next; | |
324 | } | |
325 | ||
326 | ### check if they should be of a strict type, and if it is ### | |
327 | if( ($tmpl{'strict_type'} || $STRICT_TYPE) and | |
328 | (ref $args{$key} ne ref $tmpl{'default'}) | |
329 | ) { | |
330 | _store_error(loc(q|Key '%1' needs to be of type '%2'|, | |
331 | $key, ref $tmpl{'default'} || 'SCALAR'), $verbose ); | |
332 | $wrong ||= 1; | |
333 | next; | |
334 | } | |
335 | ||
336 | ### check if we have an allow handler, to validate against ### | |
337 | ### allow() will report its own errors ### | |
7720784c RGS |
338 | if( exists $tmpl{'allow'} and not do { |
339 | local $_ERROR_STRING; | |
340 | allow( $args{$key}, $tmpl{'allow'} ) | |
341 | } | |
703d525d JB |
342 | ) { |
343 | ### stringify the value in the error report -- we don't want dumps | |
344 | ### of objects, but we do want to see *roughly* what we passed | |
345 | _store_error(loc(q|Key '%1' (%2) is of invalid type for '%3' |. | |
346 | q|provided by %4|, | |
347 | $key, "$args{$key}", _who_was_it(), | |
348 | _who_was_it(1)), $verbose); | |
349 | $wrong ||= 1; | |
350 | next; | |
351 | } | |
352 | ||
353 | ### we got here, then all must be OK ### | |
354 | $defs{$key} = $args{$key}; | |
355 | ||
356 | } | |
357 | ||
358 | ### croak with the collected errors if there were errors and | |
359 | ### we have the fatal flag toggled. | |
360 | croak(__PACKAGE__->last_error) if ($wrong || $warned) && $WARNINGS_FATAL; | |
361 | ||
362 | ### done with our loop... if $wrong is set, somethign went wrong | |
363 | ### and the user is already informed, just return... | |
364 | return if $wrong; | |
365 | ||
366 | ### check if we need to store any of the keys ### | |
367 | ### can't do it before, because something may go wrong later, | |
368 | ### leaving the user with a few set variables | |
369 | for my $key (keys %defs) { | |
370 | if( my $ref = $utmpl{$key}->{'store'} ) { | |
371 | $$ref = $NO_DUPLICATES ? delete $defs{$key} : $defs{$key}; | |
372 | } | |
373 | } | |
374 | ||
375 | return \%defs; | |
376 | } | |
377 | ||
378 | =head2 allow( $test_me, \@criteria ); | |
379 | ||
380 | The function that handles the C<allow> key in the template is also | |
381 | available for independent use. | |
382 | ||
383 | The function takes as first argument a key to test against, and | |
384 | as second argument any form of criteria that are also allowed by | |
385 | the C<allow> key in the template. | |
386 | ||
387 | You can use the following types of values for allow: | |
388 | ||
389 | =over 4 | |
390 | ||
391 | =item string | |
392 | ||
393 | The provided argument MUST be equal to the string for the validation | |
394 | to pass. | |
395 | ||
396 | =item regexp | |
397 | ||
398 | The provided argument MUST match the regular expression for the | |
399 | validation to pass. | |
400 | ||
401 | =item subroutine | |
402 | ||
403 | The provided subroutine MUST return true in order for the validation | |
404 | to pass and the argument accepted. | |
405 | ||
406 | (This is particularly useful for more complicated data). | |
407 | ||
408 | =item array ref | |
409 | ||
410 | The provided argument MUST equal one of the elements of the array | |
411 | ref for the validation to pass. An array ref can hold all the above | |
412 | values. | |
413 | ||
414 | =back | |
415 | ||
416 | It returns true if the key matched the criteria, or false otherwise. | |
417 | ||
418 | =cut | |
419 | ||
420 | sub allow { | |
421 | ### use $_[0] and $_[1] since this is hot code... ### | |
422 | #my ($val, $ref) = @_; | |
423 | ||
424 | ### it's a regexp ### | |
425 | if( ref $_[1] eq 'Regexp' ) { | |
426 | local $^W; # silence warnings if $val is undef # | |
427 | return if $_[0] !~ /$_[1]/; | |
428 | ||
429 | ### it's a sub ### | |
430 | } elsif ( ref $_[1] eq 'CODE' ) { | |
431 | return unless $_[1]->( $_[0] ); | |
432 | ||
433 | ### it's an array ### | |
434 | } elsif ( ref $_[1] eq 'ARRAY' ) { | |
435 | ||
436 | ### loop over the elements, see if one of them says the | |
437 | ### value is OK | |
438 | ### also, short-cicruit when possible | |
439 | for ( @{$_[1]} ) { | |
440 | return 1 if allow( $_[0], $_ ); | |
441 | } | |
442 | ||
443 | return; | |
444 | ||
445 | ### fall back to a simple, but safe 'eq' ### | |
446 | } else { | |
447 | return unless _safe_eq( $_[0], $_[1] ); | |
448 | } | |
449 | ||
450 | ### we got here, no failures ### | |
451 | return 1; | |
452 | } | |
453 | ||
454 | ### helper functions ### | |
455 | ||
456 | ### clean up the template ### | |
457 | sub _clean_up_args { | |
458 | ### don't even bother to loop, if there's nothing to clean up ### | |
459 | return $_[0] if $PRESERVE_CASE and !$STRIP_LEADING_DASHES; | |
460 | ||
461 | my %args = %{$_[0]}; | |
462 | ||
463 | ### keys are note aliased ### | |
464 | for my $key (keys %args) { | |
465 | my $org = $key; | |
466 | $key = lc $key unless $PRESERVE_CASE; | |
467 | $key =~ s/^-// if $STRIP_LEADING_DASHES; | |
468 | $args{$key} = delete $args{$org} if $key ne $org; | |
469 | } | |
470 | ||
471 | ### return references so we always return 'true', even on empty | |
472 | ### arguments | |
473 | return \%args; | |
474 | } | |
475 | ||
476 | sub _sanity_check_and_defaults { | |
477 | my %utmpl = %{$_[0]}; | |
478 | my %args = %{$_[1]}; | |
479 | my $verbose = $_[2]; | |
480 | ||
481 | my %defs; my $fail; | |
482 | for my $key (keys %utmpl) { | |
483 | ||
484 | ### check if required keys are provided | |
485 | ### keys are now lower cased, unless preserve case was enabled | |
486 | ### at which point, the utmpl keys must match, but that's the users | |
487 | ### problem. | |
488 | if( $utmpl{$key}->{'required'} and not exists $args{$key} ) { | |
489 | _store_error( | |
490 | loc(q|Required option '%1' is not provided for %2 by %3|, | |
491 | $key, _who_was_it(1), _who_was_it(2)), $verbose ); | |
492 | ||
493 | ### mark the error ### | |
494 | $fail++; | |
495 | next; | |
496 | } | |
497 | ||
498 | ### next, set the default, make sure the key exists in %defs ### | |
499 | $defs{$key} = $utmpl{$key}->{'default'} | |
500 | if exists $utmpl{$key}->{'default'}; | |
501 | ||
502 | if( $SANITY_CHECK_TEMPLATE ) { | |
503 | ### last, check if they provided any weird template keys | |
504 | ### -- do this last so we don't always execute this code. | |
505 | ### just a small optimization. | |
506 | map { _store_error( | |
507 | loc(q|Template type '%1' not supported [at key '%2']|, | |
508 | $_, $key), 1, 1 ); | |
509 | } grep { | |
510 | not $known_keys{$_} | |
511 | } keys %{$utmpl{$key}}; | |
512 | ||
513 | ### make sure you passed a ref, otherwise, complain about it! | |
514 | if ( exists $utmpl{$key}->{'store'} ) { | |
515 | _store_error( loc( | |
516 | q|Store variable for '%1' is not a reference!|, $key | |
517 | ), 1, 1 ) unless ref $utmpl{$key}->{'store'}; | |
518 | } | |
519 | } | |
520 | } | |
521 | ||
522 | ### errors found ### | |
523 | return if $fail; | |
524 | ||
525 | ### return references so we always return 'true', even on empty | |
526 | ### defaults | |
527 | return \%defs; | |
528 | } | |
529 | ||
530 | sub _safe_eq { | |
531 | ### only do a straight 'eq' if they're both defined ### | |
532 | return defined($_[0]) && defined($_[1]) | |
533 | ? $_[0] eq $_[1] | |
534 | : defined($_[0]) eq defined($_[1]); | |
535 | } | |
536 | ||
537 | sub _who_was_it { | |
538 | my $level = $_[0] || 0; | |
539 | ||
540 | return (caller(2 + $CALLER_DEPTH + $level))[3] || 'ANON' | |
541 | } | |
542 | ||
543 | =head2 last_error() | |
544 | ||
545 | Returns a string containing all warnings and errors reported during | |
546 | the last time C<check> was called. | |
547 | ||
548 | This is useful if you want to report then some other way than | |
549 | C<carp>'ing when the verbose flag is on. | |
550 | ||
551 | It is exported upon request. | |
552 | ||
553 | =cut | |
554 | ||
7720784c | 555 | { $_ERROR_STRING = ''; |
703d525d JB |
556 | |
557 | sub _store_error { | |
558 | my($err, $verbose, $offset) = @_[0..2]; | |
559 | $verbose ||= 0; | |
560 | $offset ||= 0; | |
561 | my $level = 1 + $offset; | |
562 | ||
563 | local $Carp::CarpLevel = $level; | |
564 | ||
565 | carp $err if $verbose; | |
566 | ||
7720784c | 567 | $_ERROR_STRING .= $err . "\n"; |
703d525d JB |
568 | } |
569 | ||
570 | sub _clear_error { | |
7720784c | 571 | $_ERROR_STRING = ''; |
703d525d JB |
572 | } |
573 | ||
7720784c | 574 | sub last_error { $_ERROR_STRING } |
703d525d JB |
575 | } |
576 | ||
577 | 1; | |
578 | ||
579 | =head1 Global Variables | |
580 | ||
581 | The behaviour of Params::Check can be altered by changing the | |
582 | following global variables: | |
583 | ||
584 | =head2 $Params::Check::VERBOSE | |
585 | ||
586 | This controls whether Params::Check will issue warnings and | |
587 | explanations as to why certain things may have failed. | |
588 | If you set it to 0, Params::Check will not output any warnings. | |
589 | ||
590 | The default is 1 when L<warnings> are enabled, 0 otherwise; | |
591 | ||
592 | =head2 $Params::Check::STRICT_TYPE | |
593 | ||
594 | This works like the C<strict_type> option you can pass to C<check>, | |
595 | which will turn on C<strict_type> globally for all calls to C<check>. | |
596 | ||
597 | The default is 0; | |
598 | ||
599 | =head2 $Params::Check::ALLOW_UNKNOWN | |
600 | ||
601 | If you set this flag, unknown options will still be present in the | |
602 | return value, rather than filtered out. This is useful if your | |
603 | subroutine is only interested in a few arguments, and wants to pass | |
604 | the rest on blindly to perhaps another subroutine. | |
605 | ||
606 | The default is 0; | |
607 | ||
608 | =head2 $Params::Check::STRIP_LEADING_DASHES | |
609 | ||
610 | If you set this flag, all keys passed in the following manner: | |
611 | ||
612 | function( -key => 'val' ); | |
613 | ||
614 | will have their leading dashes stripped. | |
615 | ||
616 | =head2 $Params::Check::NO_DUPLICATES | |
617 | ||
618 | If set to true, all keys in the template that are marked as to be | |
619 | stored in a scalar, will also be removed from the result set. | |
620 | ||
621 | Default is false, meaning that when you use C<store> as a template | |
622 | key, C<check> will put it both in the scalar you supplied, as well as | |
623 | in the hashref it returns. | |
624 | ||
625 | =head2 $Params::Check::PRESERVE_CASE | |
626 | ||
627 | If set to true, L<Params::Check> will no longer convert all keys from | |
628 | the user input to lowercase, but instead expect them to be in the | |
629 | case the template provided. This is useful when you want to use | |
630 | similar keys with different casing in your templates. | |
631 | ||
632 | Understand that this removes the case-insensitivy feature of this | |
633 | module. | |
634 | ||
635 | Default is 0; | |
636 | ||
637 | =head2 $Params::Check::ONLY_ALLOW_DEFINED | |
638 | ||
639 | If set to true, L<Params::Check> will require all values passed to be | |
640 | C<defined>. If you wish to enable this on a 'per key' basis, use the | |
641 | template option C<defined> instead. | |
642 | ||
643 | Default is 0; | |
644 | ||
645 | =head2 $Params::Check::SANITY_CHECK_TEMPLATE | |
646 | ||
647 | If set to true, L<Params::Check> will sanity check templates, validating | |
648 | for errors and unknown keys. Although very useful for debugging, this | |
649 | can be somewhat slow in hot-code and large loops. | |
650 | ||
651 | To disable this check, set this variable to C<false>. | |
652 | ||
653 | Default is 1; | |
654 | ||
655 | =head2 $Params::Check::WARNINGS_FATAL | |
656 | ||
657 | If set to true, L<Params::Check> will C<croak> when an error during | |
658 | template validation occurs, rather than return C<false>. | |
659 | ||
660 | Default is 0; | |
661 | ||
662 | =head2 $Params::Check::CALLER_DEPTH | |
663 | ||
664 | This global modifies the argument given to C<caller()> by | |
665 | C<Params::Check::check()> and is useful if you have a custom wrapper | |
666 | function around C<Params::Check::check()>. The value must be an | |
667 | integer, indicating the number of wrapper functions inserted between | |
668 | the real function call and C<Params::Check::check()>. | |
669 | ||
670 | Example wrapper function, using a custom stacktrace: | |
671 | ||
672 | sub check { | |
673 | my ($template, $args_in) = @_; | |
674 | ||
675 | local $Params::Check::WARNINGS_FATAL = 1; | |
676 | local $Params::Check::CALLER_DEPTH = $Params::Check::CALLER_DEPTH + 1; | |
677 | my $args_out = Params::Check::check($template, $args_in); | |
678 | ||
679 | my_stacktrace(Params::Check::last_error) unless $args_out; | |
680 | ||
681 | return $args_out; | |
682 | } | |
683 | ||
684 | Default is 0; | |
685 | ||
686 | =head1 AUTHOR | |
687 | ||
688 | This module by | |
689 | Jos Boumans E<lt>kane@cpan.orgE<gt>. | |
690 | ||
691 | =head1 Acknowledgements | |
692 | ||
693 | Thanks to Richard Soderberg for his performance improvements. | |
694 | ||
695 | =head1 COPYRIGHT | |
696 | ||
697 | This module is | |
698 | copyright (c) 2003,2004 Jos Boumans E<lt>kane@cpan.orgE<gt>. | |
699 | All rights reserved. | |
700 | ||
701 | This library is free software; | |
702 | you may redistribute and/or modify it under the same | |
703 | terms as Perl itself. | |
704 | ||
705 | =cut | |
706 | ||
707 | # Local variables: | |
708 | # c-indentation-style: bsd | |
709 | # c-basic-offset: 4 | |
710 | # indent-tabs-mode: nil | |
711 | # End: | |
712 | # vim: expandtab shiftwidth=4: |