File Coverage

blib/lib/Params/Clean.pm
Criterion Covered Total %
statement 21 23 91.3
branch n/a
condition n/a
subroutine 9 9 100.0
pod n/a
total 30 32 93.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3              
4             #################################################################################################################################################################
5              
6             =head1 NAME
7              
8             B (Parse A Routine Allowing Modest Syntax--Casually List Explicit Arg Names): Process @_ as positional/named/flag/list/typed arguments
9              
10             =cut
11              
12             #################################################################################################################################################################
13              
14              
15              
16             =head1 SYNOPSIS
17              
18             Instead of starting your sub with C
19              
20             #Get positional args, named args, and flags
21             my ( $x, $y, $z, $blue, $man, $group, $semaphore, $six_over_texas )
22             = args POSN 0, 1, 2, NAME fu, man, chu, FLAG pennant, banner;
23            
24             #Any of the three types of argument is optional
25             my ($tom, $dick, $harry) = args NAME tom, randal, larry;
26            
27             #...or repeatable -- order doesn't matter
28             my ($p5, $s, @others) = args NAME pearl, FLAG white, NAME ruby, POSN 0;
29            
30             #If no types specified, ints are taken to mean positional args, text as named
31             my ($fee, $fo, $fum) = args 0, -1, jack;
32            
33             #Can also retrieve any args left over after pulling out NAMEs/FLAGs/POSNs/etc.
34             my ($gilligan, $skipper, $thurston, $lovey, $ginger, @prof_mary_ann)
35             = args first_mate, skipper, millionaire, wife, star, REST;
36            
37             #Or collect args that qualify as matching a certain type
38             my ($objects, @rest) = args TYPE "Class::Name", REST; # ref() string
39             my ($files, @rest) = args TYPE \&is_filehandle, REST; # code-ref
40            
41             #Specify a LIST by giving starting and (optional) ending points
42             # <=> includes end-point in the returned list; <= excludes it
43             my ($fields, $tables, $conditions)
44             = args LIST Select<=From, LIST From<=Where, LIST Where<=>-1;
45            
46             #Or by giving a list of positions relative to the LIST's starting point
47             my ($man, $machine) = args LIST vs = [-1, 1];
48             my ($tick, $santa) = args LIST vs & [-1, 1]; # include starting key
49             my ($kong, $godzilla)=args LIST vs ^ [-1, 1]; # exclude starting key
50            
51             #Specify synonymous alternatives using brackets
52             my ($either_end, $tint) = args [0, -1], [Colour, Color];
53              
54              
55             =head1 VERSION
56              
57             Version 0.9.4 (December 2007)
58              
59             This version introduces the PARSE keyword.
60              
61             =cut
62              
63              
64              
65              
66             #===========================================================================
67             #
68             # INFRASTRUCTURE
69             #
70             #===========================================================================
71              
72             package Params::Clean;
73 9     9   175174 use version; our $VERSION = qv"0.9.4";
  9         18612  
  9         87  
74            
75 9     9   726 use 5.6.0; # Because we use "our", etc.
  9         53  
  9         330  
76 9     9   47 use strict; use warnings; no warnings qw(uninitialized); # Be good little disciplinarians (but not too good)
  9     9   25  
  9     9   223  
  9         46  
  9         19  
  9         263  
  9         44  
  9         16  
  9         319  
77 9     9   10912 use Devel::Caller::Perl 'called_args'; # for stealing our caller's @_
  9         51203  
  9         61  
78            
79            
80             our (@keywords, @KEYWORDS); # We need to declare these and then init them with BEGIN so they're ready for the "use UID"
81 9     9   784 BEGIN { our @keywords=qw/POSN NAME FLAG REST TYPE PARSE/; } # UID keywords
82 9     9   251 BEGIN { our @KEYWORDS=(@keywords, "LIST", "args"); } # all keywords (LIST handled specially)
83            
84 9     9   18639 use UID @keywords; # Set up some lexicals that won't be available anywhere else, so exporting refs to them will act as unique identifiers
  0            
  0            
85            
86             our %Warn; # categories of warning levels by caller: e.g. $Warn{main}{missing_start}=fatal
87             BEGIN {
88             $Warn{undef}={ # default warning levels
89             invalid_opts=>"warn", # illegal warning or keyword options used
90             funny_arglist=>"ignore", # asked to PARSE something that's not an ARRAY, HASH, or CODE
91             missing_start=>"ignore", # LIST cannot find specified starting key
92             missing_end=>"warn", # LIST cannot find specified ending key
93             invalid_list=>"warn", # tried to use a FLAG or LIST, etc, as endpoint to a LIST
94             invalid_type=>"warn", # tried to use an illegal TYPE definition
95             nonint_name=>"warn", # non-integral key will be used as a name
96             orphaned_type=>"warn", # TYPE not followed by a definition
97             misplaced_rest=>"warn", # REST used before last parameter
98             misplaced_parse=>"die", # PARSE used after first parameter
99             };
100             }
101             # now create constants with all our exception-type names (handy, and helps catch typos!)
102             BEGIN { no strict 'refs'; for my $s (keys %{$Warn{undef}}) {*{$s}=sub {return $s, @_ if wantarray; warn "ERROR: attempt to use args after '$s' which is in scalar context (perhaps you need a comma after '$s'?)" if @_; return $s};} } # stolen from UID.pm
103            
104            
105             our $CaseSensitive=0; # By default, we match match names case-insensitively
106             our $Debug=0; # Whether to show debugging messages (0 level=none)
107             sub same($$); sub insame($@); sub typewriter($$); sub warning; # predeclare!
108             sub un {grep !$_[$_], 0..@_-1;} # pull out all the keys that work out to false (used with @used!)
109             sub array { map ref($_) eq "ARRAY"?@$_:$_, (@_) } # Normalise a list by expanding array-refs
110             sub comma { "[".join(", ", array @_)."]" } # Format array(ref) into "[a, b, c]"
111            
112             sub debug
113             # For showing debugging messages
114             # Does some basic cleanup, like unpacking array-refs, or looking up our UIDs
115             # Pass each thing you want cleaned as a separate arg
116             {
117             return unless $Debug>=shift; # do nothing unless our debugging level is high enough
118             my $i; my %ID=reverse(POSN=>POSN, FLAG=>FLAG, NAME=>NAME, TYPE=>TYPE, REST=>REST); # lookup hash for our special IDs
119             warn join " ", map $ID{$_}?"|$ID{$_}|":ref eq"ARRAY"?"[".(join " ", map $ID{$_}?"|$ID{$_}|":$_, (@$_))."]":ref eq "HASH"?"{".(join "", map {$i++%2?"$_; ":"$_=>"} %$_)."}":"$_", (@_), "\n"
120             }
121            
122            
123              
124             #===========================================================================
125             #
126             # STARTUP
127             #
128             #===========================================================================
129            
130             sub import
131             # Handle module options: renaming exported UIDs and setting desired warnings
132             #
133             # RENAMING: pass a keyword ID followed by the new name (LIST=>"PLIST") -- setting to undef means don't export it at all
134             # WARNINGS: warn=>"type", or die=>"type" or fatal=>"type", or ignore=>"type"
135             {
136             my $me=shift; # our package name
137             my @opts, my $i; push @opts, [$_[$i++]=>$_[$i++]] while $i<@_; # pair up the options (we would use a hash, but we want to preserve order, and anyway we could have the same key repeated)
138             my %EXPORT=map {$_=>$_} @KEYWORDS; # keywords to be exported (normally all @KEYWORDS) in convenient hash format
139             my $keys=join "|", @KEYWORDS; # for regex to test for any of our keywords
140             my $caller=(caller)[0]; # caller's package
141            
142            
143             # Set up warning/fatal/ignoral categories
144             $Warn{$caller}={%{$Warn{undef}}}; # start by setting up default warning levels
145             for (grep $opts[$_][0]=~/^(warn|die|fatal|ignore)$/, 0..$#opts) # grep through the key-halves of each opt for exception-levels
146             {
147             my $opt=delete $opts[$_];
148             warning(invalid_opts qq[WARNING: Ignoring attempt to set unrecogised warning category "$opt->[1]"]) and next unless exists $Warn{$caller}{$opt->[1]}; # complain if trying to set an invalid category
149             $Warn{$caller}{$opt->[1]}=$opt->[0]; # set level for this caller and remove opts as we handle them
150             }
151            
152            
153             # Look for our keywords: pairs that start with a keyword substitute the new name instead
154             $EXPORT{$opts[$_][0]}=$opts[$_][1] and delete $opts[$_] for grep $opts[$_][0]=~/^($keys)$/, grep exists $opts[$_], 0..$#opts; # look for our keywords and remove opts as we deal with them
155             no strict 'refs'; # so we can manually "export" the subs to the caller's namespace
156             *{$caller."::".$EXPORT{$_}}=\&{$_} for grep defined $EXPORT{$_}, keys %EXPORT; # skipping undefs
157            
158            
159             # If there are any opts left, we don't know what to do with them
160             warning invalid_opts "WARNING: Ignoring unrecognised options [".join(", ", map "$opts[$_][0]=>$opts[$_][1]", grep exists $opts[$_], 0..$#opts)."]" if @opts;
161             }
162            
163            
164            
165             #===========================================================================
166             #
167             # LISTs
168             #
169             #===========================================================================
170            
171             # "LIST" types are objects containing the pieces we need to handle lists
172             # {
173             # spec => what kind of list this is: olute or ative,
174             # start => the param key(s) which begin the list,
175             # end => the param(s) which end an absolute list,
176             # pos => the list of positions to grab for a relative list,
177             # incl => a flag indicating whether to include the starting/ending param
178             # }
179             #
180             # A few operators are overloaded to provide convenient syntax for building up our LIST objects
181             # Since assignment isn't overloadable, we also tie our object so we can STORE it ourselves
182            
183             sub LIST ($) :lvalue { tie my $list, __PACKAGE__, @_; $list } # takes a single arg and turns it into a tied List-object
184             sub TIESCALAR { my $class=shift; bless {spec=>"abs", start=>[array @_]}, $class } # object is a hash containing the setup; all we know upon creation is the starting-point; assume absolute [can override that later if we specify more details]
185             sub FETCH { shift; }; # nothing fancy here, just return the object straight
186            
187             use overload '<=>',sub { @{$_[0]}{spec=>end=>incl=>}=("abs", [array $_[1]], 1); shift }; # absolute list, include end point
188             use overload '<=', sub { @{$_[0]}{spec=>end=>incl=>}=("abs", [array $_[1]], 0); shift }; # absolute list, don't include end point
189            
190             sub STORE($) { @{$_[0]}{spec=>pos=>incl=>}=("rel", [array $_[1]], "?"); } # "overload =": relative, don't force starting point either way
191             use overload '&', sub { @{$_[0]}{spec=>pos=>incl=>}=("rel", [array $_[1]], "Y"); shift }; # relative list, include start point
192             use overload '^', sub { @{$_[0]}{spec=>pos=>incl=>}=("rel", [array $_[1]], "N"); shift }; # relative list, don't include start point
193            
194             use overload q(""), sub { "{". (join ", ", map "$_=>".(join ":", array($_[0]->{$_})), (qw/spec start end pos incl/) )."}" }; #stringify for debug messages
195             ###check for attempting to use operators more than once in a row? or to use other operators?!?
196            
197              
198              
199             #===========================================================================
200             #
201             # PARSE ARGS
202             #
203             #===========================================================================
204            
205             sub args
206             {
207              
208             #------------------------------------------------------
209             # DECLARE/INITIALISE VARIABLES
210             #------------------------------------------------------
211            
212             my @sig=@_; # The signature specifying how to parse the caller's args
213            
214             # Get args to be parsed
215             if (same $sig[0], PARSE) # then specially passed in the list to parse
216             { shift @sig; @_=preparse(shift @sig); } # drop first arg(=PARAM) and grab the second(=arrayref)
217             else # we use [the caller's] @_ by default
218             { @_=called_args(0); } # get the @_ args passed in to the original sub (=our caller)
219            
220             my $n; # Counter for which parameter we're processing
221             my $type; # holder for the ID of the arg-type currently being processed
222             my $subtype; # holder for the arg-type inside a param group
223              
224             my @keys; # Holds the param key(s) we're going to look for at any one time
225             my @used=(undef)x@_; # track which args we've used (filled out so we can use it in parallel with @_)
226             my $rest; # flag indicating whether to return any leftover args
227             my @REST; # list of leftover args, if any
228              
229             my @results; # the resulting args for each param ($result[$n]=array ref containing all possible args matching that param)
230             my $results; # collects results in a string for debugging
231             my @number; # the count of resulting args for each param ($number[$n]=count of @$results[$n])
232            
233             our $args=@_; # number of args ("our" so other subs can see it, specifically parse())
234            
235             local $_; # so we don't clobber $_
236              
237            
238             #------------------------------------------------------
239             # LOOP THROUGH PARAMS, GRAB MATCHING ARGS
240             #------------------------------------------------------
241            
242             debug 4, POSN=>POSN, FLAG=>FLAG, NAME=>NAME, TYPE=>TYPE, REST=>REST;
243             debug 1, "ARGS: @_\n";
244            
245             my $typesub;
246             for my $param (@sig)
247             {
248             warning misplaced_rest "WARNING: attempt to use REST before last parameter" and $rest++ if $rest==1; # complain if REST flag is set and we're still looping (i.e. not done with the sig) [increment and check only when ==1 so the warning doesn't spam us every time through the loop!]
249            
250             warning misplaced_parse "ERROR: encountered PARSE after beginning of parameter list" if same $param, PARSE; # complain if PARSE wasn't the first parameter (would've been dealt with above)
251            
252             #Switch type whenever we hit one of our identifiers
253            
254             if ($type==PARSE) # We found a PARSE keyword last pass through (which was an error, of course)
255             {
256             warning misplaced_parse "\tIgnoring misplaced PARSE values"; # but too late to do anything with them
257             undef $type; # reset for next arg
258             }
259             elsif ($typesub) # previous item was a TYPE type, so look for the sub
260             {
261             $param=[TYPE, $param]; # put our TYPE=>sub into an array-ref so we can deal with it as a single unit below
262             $typesub=0;
263             debug 2, "\t", $param, "TYPE-sub";
264             redo; # start checking again; our new array-ref will get handled by the "else" below
265             }
266             elsif (same $param, TYPE)
267             {
268             $typesub=1; # set flag so next pass we can grab the type-sub
269             }
270             elsif (insame $param => POSN, NAME, FLAG, PARSE) # we've hit one of our types
271             {
272             $type=$param; # Switch current type-holder to that type
273             debug 2, "\t", $type, "type";
274             }
275             elsif (same $param, REST)
276             {
277             $rest=1; # Flag=true: we want to return any leftover args
278            
279             }
280             elsif (ref($param) eq __PACKAGE__) # if it's one of our objects, it must be a LIST
281             {
282             my $err; # holds error message if something goes wrong
283             debug 3, "\t LIST", $param;
284            
285             #Break up a parameter [list] into keys and subtypes
286             debug 3, "\t\tChecking starting params", $param->{start};
287             my ($keys, $types)=parse($param->{start}, $type);
288            
289            
290             #Begin by finding the start key
291             my $start; # will contain the index of the starting arg (once we've found it)
292             Arg: for my $a (un@used) # only remaining unused args can be potential keys
293             {
294             for my $i (0..@$keys-1) # compare arg against each key
295             {
296             my ($key, $kind) = ($keys->[$i], $types->[$i]);
297             debug 4, "\t#$n\tKey[$i]:", $key, "\tType:", $kind, "\tArg[$a]:", $_[$a], ;
298            
299             if (ref $key eq __PACKAGE__) # check this first because LIST produces a key that is a LIST-object, but doesn't affect the current $kind
300             {
301             $err="Whoa, can't use other LISTs inside a LIST! Ignoring starting param key: @{$key->{start}}";
302             }
303             elsif (insame $kind => FLAG, TYPE)
304             {
305             $err="Whoa, can't use FLAGs or TYPEs inside a LIST! Ignoring starting param key: $key";
306             }
307             elsif ( ($kind==POSN and $a==$key) or ($kind==NAME and same $_[$a], $key) )
308             {
309             debug 3, "\t\t", $kind, "«$key» matches «$_[$a]»";
310             $start=$a; last Arg; # no need to check any other args once we've got the starting point
311             }
312             }
313             }
314            
315             debug 2, "\t\tStarting arg[$start] =", $_[$start];
316             if (!defined $start)
317             {
318             unless ($err) # we might already have an error because of an invalid starting key
319             {
320             $err="ERROR: couldn't find beginning of LIST starting with ".comma $param->{start};
321             $err.=" (probably already used up by another param!)" if insame $param->{start}->[0], @_; # more helpful message -- if starting keyword really is in the arg list, then we most likely can't find it because it already got used somewhere else
322             }
323            
324             warning missing_start $err;
325            
326             $results[$n++]=[]; push @number, undef; # add an empty result since we could find it properly
327             next;
328             }
329            
330             #Next we want to build up a list of indices of the args that should go in this list
331             # If it's a relative list, the elements are defined by $list->{pos}
332             # If it's absolute, we need to loop through the args until we hit the end point
333            
334             my @grab; # will store the arg indices we want
335            
336             if ($param->{spec} eq "rel") # relative lists already know the positions to grab
337             {
338             my %grab; # use a hash because it's an easy way to prevent duplicates
339             @grab{@{$param->{pos}}}=1; # set all the desired keys to true to grab everything
340            
341             if ($param->{incl} eq "Y") { $grab{0}=1; } # if LIST is inclusive, grab the starting key itself (the 0 position)
342             elsif ($param->{incl} eq "N") { delete $grab{0}; } # else LIST is exclusive, so make sure exclude 0 in the positions
343             $used[$start]=1; # even if we're not collecting the starting key itself, we still want to make sure it gets flagged as used
344            
345             @grab=map $_+$start, (sort keys %grab); # convert relative positions into absolute, all sorted and unique
346             debug 3, "\t\tRelative:", @grab;
347             }
348             else # must be an absolute list
349             {
350             #Search for the ending point, collecting the in-between elements as we go
351             my $end; # will contain the index of the ending arg (once we've found it)
352              
353             if ($param->{end}) # an ending key was specified, so search for it
354             {
355             #Break up a parameter [list] into keys and subtypes
356             debug 3, "\t\tChecking ending params", $param->{end};
357             my ($keys, $types)=parse($param->{end}, $type);
358            
359             #Finish by finding the end key
360             Arg: for my $a (un@used) # only remaining unused args can be potential keys
361             {
362             next unless $a>$start; # don't look for the end prior to the start!
363            
364             for my $i (0..@$keys-1) # compare arg against each key
365             {
366             my ($key, $kind) = ($keys->[$i], $types->[$i]);
367             debug 4, "\t#$n\tKey[$i]:", $key, "\tType:", $kind, "\tArg[$a]:", $_[$a], ;
368            
369             if (ref $key eq __PACKAGE__) # check this first because LIST produces a key that is a LIST-object, but doesn't affect the current $kind
370             {
371             $err="Whoa, can't use other LISTs inside a LIST! Ignoring ending param key: @{$key->{start}}";
372             }
373             elsif (insame $kind => FLAG, TYPE)
374             {
375             $err="Whoa, can't use FLAGs or TYPEs inside a LIST! Ignoring list with ending param key: $key";
376             $end=$start; # invalid ending point, so collect only the starting point
377             }
378             elsif ( ($kind==POSN and $a==$key) or ($kind==NAME and same $_[$a], $key) )
379             {
380             debug 3, "\t\t", $kind, "«$key» matches «$_[$a]»";
381             $end=$a; last Arg; # no need to check any other args once we've got the ending point
382             }
383             #### ^---- should make this into a function -- almost identical to the same code for Starting keys
384             }
385             }
386            
387             if ($err or !defined $end)
388             {
389             unless ($err) # we might already have an error because of an invalid starting key
390             {
391             $err="ERROR: couldn't find ending of LIST from ".comma($param->{start})." to ".comma($param->{end});
392             $err.=" (probably already used up by another param!)" if insame $param->{end}->[0], @_; # more helpful message -- if ending keyword really is in the arg list, then we most likely can't find it because it already got used somewhere else
393             }
394            
395             warning missing_end $err;
396             $end=$args-1 unless defined $end; #to grab all until end... or should we skip this because of the error: "next;" ??
397             }
398             elsif (!$param->{incl})
399             {
400             $end--; # back up if exclusive -- don't include the ending arg itself
401             }
402             }
403             else # no ending key specified means go up to the next used arg
404             {
405             debug 3, "\t\tEndless list...";
406             $end=$start; # we go at least this far!
407             $end++ while !$used[$end] and $end<$args-1; # bump up as long as we're not used, or haven't run off the end of the args yet
408             }
409            
410             debug 2, "\t\tEnding arg[$end] =", $_[$end];
411            
412             #Now collect all the args up to the ending point
413             for my $a ($start..$end)
414             {
415             push @grab, $a if !$used[$a];
416             $used[$a]=1; # if it wasn't used before, it is now!
417             }
418            
419             debug 3, "\t\tAbsolute: [$start..$end] ", @grab;
420             }
421            
422             #Now that we know what items we want, grab them!
423             for (@grab)
424             {
425             push @{$results[$n]}, $_[$_];
426             $used[$_]=1;
427             }
428            
429             debug 2, "---> LIST", $param, "=", @{$results[$n]}, "\n";
430             push @number, 0-@{$results[$n]}; #<--negative to force array-ref! # keep count of how many args we just collected
431             $n++; # ready for next param
432             }
433             #else we've possibly hit a variable-ref, once we add features for mixing them in to the specs! =)
434             #
435             else #we've hit a param specifier (or array-ref'd group of them)
436             {
437             #Get all the param keys we're looking for for this arg into a standard format (an array, @keys)
438             # possibly multiple options for the key, normalise on an array whether we have a single value or more
439             debug 4, "Checking params", $param;
440             my ($keys, $types)=parse($param, $type);
441            
442            
443             # Now loop through all the args and pick out the ones that match the param keys
444             debug 3, "\tunused: ", un@used;
445             debug 3, "\tSEEKING:", @$keys;
446            
447             for my $a (un@used) # only remaining unused args can be potential keys
448             {
449             for my $i (0..@$keys-1) # compare arg against each key
450             {
451             my ($key, $kind) = ($keys->[$i], $types->[$i]);
452             debug 4, "\t#$n\tKey[$i]:", $key, "\tType:", $kind, "\tArg[$a]:", $_[$a];
453            
454             if ($kind==POSN and $a==$key)
455             {
456             push @{$results[$n]}, $_[$a];
457             $used[$a]=1;
458             last; # no need to check any other keys against this arg, we already grabbed it
459             }
460             elsif ($kind==FLAG and same $_[$a], $key)
461             {
462             $results[$n]->[0]++; # count the flag
463             ######### hm, fine if only a flag, we can ++ to count it... but what if we try to synonymise [POSN 1, NAME foo, FLAG bar]??? $res[0] might not be the flag one, hm, then what?!?!?
464             $used[$a]=1;
465             debug 3, "\t «$key» matches «$_[$a]»";
466             last; # no need to check any other keys against this arg, we already grabbed it
467             }
468             elsif ($kind==NAME and same $_[$a], $key)
469             {
470             push @{$results[$n]}, $_[$a+1];
471             $used[$a]=1; $used[$a+1]=1; # mark param key and its arg value as used
472             debug 3, "\t «$key» matches «$_[$a]: $_[$a+1]»";
473             last; # no need to check any other keys against this arg, we already grabbed it
474             }
475             elsif ($kind==TYPE) # TYPE and &typesub(arg) returns true
476             {
477             my $match; # flag whether the current arg matches this TYPE, once we figure out what the type is!
478             if ( ref($key) eq "CODE" ) { $match=&$key($_[$a]) } # if CODE, call it with the arg to see whether it meets the criteria
479             #anything else to check for? the the CODE takes a single arg?
480             elsif ( !ref($key) ) { $match=$key eq ref($_[$a]) } # if $key is a plain value (string), then see if the arg is that kind of ref/class
481             # other possibilities? Compare classes/refs directly (does that make sense??)
482            
483             else # not a type of TYPE that we recognise!
484             {
485             debug 2, "ERROR! Invalid TYPE!!!\t#$n\tKey[$i]:", $key, "\tType:", $kind, "\tArg[$a]:", $_[$a];
486             warning invalid_type "WARNING: attempt to use invalid TYPE";
487             }
488            
489             if ($match)
490             {
491             push @{$results[$n]}, $_[$a];
492             $used[$a]=1;
493             debug 3, "\t «$_[$a]» is", $key;
494             last; # no need to check any other keys against this arg, we already grabbed it
495             }
496             }
497             #else... should be impossible to reach here; everything already accounted for and caught above...
498             }
499             }
500            
501             debug 2, "--->", $param, "=", @{$results[$n]}, "\n";
502            
503             push @number, 0+@{$results[$n]}; # keep count of how many args we just collected
504             $n++; # ready for next param
505             }
506             }
507            
508             debug 2, "\tunused:", un@used, "\n\n";
509            
510            
511             #------------------------------------------------------
512             # THAT'S ALL OF THEM, RETURN THE RESULTS!
513             #------------------------------------------------------
514            
515             for $n (0..$#results)
516             # Each result is an array-ref -- figure out whether to return single value or array-ref:
517             # if single, return scalar; if multiple values, or negative count (=force array), return arrayref
518             {
519             $results[$n]=$results[$n]->[0] if $number[$n]==0 || $number[$n]==1; # if only one (or no) elements, use a scalar
520             $results.=($number[$n]==0 || $number[$n]==1 ? " $results[$n] " : " [@{$results[$n]}]") if $Debug; # build string for debugging
521             }
522              
523             debug 1, "SIG:", $results[$n], (@sig);
524             debug 1, " #: ", @number;
525             debug 1, "VARS:$results" . ($rest?" -- @_[un@used]":"")."\n";
526            
527             push @results, @_[un@used] if $rest; # remaining unused args = REST
528             return @results;
529             }
530            
531            
532            
533             #===========================================================================
534             #
535             # SAME
536             #
537             #===========================================================================
538            
539             sub same($$)
540             # Compare two items
541             #
542             # String comparison -- case insensitive depending on our settings
543             # Also compares ref's and so can be used to do special unique ID (or object) comparisons
544             # Note that we use lc() (for case-insensitive comparisons) only if both args are strings (no ref)
545             {
546             ref($_[0]) eq ref($_[1]) and # must be same type
547             ($CaseSensitive || ref($_[0]) || ref($_[1])) # if objects involved, or case-sensitive strings,
548             ? $_[0] eq $_[1] # then do an exact comparison
549             : lc $_[0] eq lc $_[1]; # otherwise case-insensitive
550             }
551            
552             #===========================================================================
553            
554             sub insame($@)
555             # Compare one item to all the elements in a list
556             # Returns true if anything in the list is the same() as the first arg
557             {
558             my $i=shift; # first item, the one to search for in the list
559             for (@_)
560             {
561             return 1 if same($i, $_); # this one matched
562             }
563             return undef; # made it through whole list with no matches
564             }
565            
566            
567            
568             #===========================================================================
569             #
570             # TYPEWRITER
571             #
572             #===========================================================================
573            
574             sub typewriter($$)
575             # Figure out what type to use for a parameter
576             #
577             # typewriter($param, $type)
578             # $param = the parameter key under consideration
579             # $type = if set, force the parameter to be evaluated as this type
580             {
581             my ($param, $type)=@_;
582            
583             return $type if $type; # If a type has been set, use it
584             ### But how to emit a warning if we detect a type mismatch -- even if warnings weren't asked for, because it's important to let the user know that we're overriding $param and making it "0"
585             ###if ($t==POSN && !$numeric) { warnings::warn "WARNING: using non-numeric key '$param' as positional parameter"; $param=0; }
586             ### ???warning if we're looking for POSNs and our key doesn't look like an int (force item to zero to prevent refs evaluating to huge numbers!)
587            
588             return NAME if ref $param; # an object or something... could numify to an int, but we want to preserve it???
589             ###... or should we check for stringification first? what to do about objects/refs... can numify to ints, hm...
590            
591             # If no type is set, check whether the parameter looks like an int or a string and assume POSN or NAMES accordingly...
592             no warnings; # or else we get "Argument isn't numeric in <" =P
593             if ($param<0 || $param>0 || $param=~/^\s*[+-]?0+\.?0*\s*$/) # evaluates as a number (neg, pos, or looks like 0)
594             {
595             return POSN if $param==int($param); # numeric and an int
596             ###Maybe warn if some kind of ref? not an object?? Hm....
597             ##perhaps use "$param"<0, etc., since a stringified int will still numify to an int...
598             warning nonint_name if "WARNING: non-integral number $param will be interpreted as a named parameter";
599             }
600            
601             # Not an int, so assume named
602             return NAME;
603             }
604            
605            
606            
607             #===========================================================================
608             #
609             # WARNINGS
610             #
611             #===========================================================================
612            
613             sub warning
614             # Display a warning message, or die, or do nothing, according to our error levels
615             {
616             my $category=shift; # error category, as controlled by %Warn
617             my $level=1; # start one level up (our caller)
618             my @caller=(caller $level); # to find out whose settings to use;
619             @caller=(caller ++$level) while $caller[0] eq __PACKAGE__; # keep moving a level up until we go beyond our own package
620            
621             my $w=$Warn{$caller[0]}{$category};
622            
623             return if $w eq "ignore";
624             warn "@_ at $caller[1] line $caller[4]\n";
625             die "\t(Fatal exception category: $category)\n" if $w eq "die" or $w eq "fatal";
626             }
627            
628            
629            
630             #===========================================================================
631             #
632             # PREPARSE LIST of ARGS
633             #
634             #===========================================================================
635            
636             sub preparse
637             # Get the list of args to be parsed, passed in via a PARSE keyword
638             {
639             my $args=shift; # we pass in a single value
640             my $ref=ref $args || "value";
641            
642             # normally, the list should be passed in as an array-ref
643             return @$args if $ref eq "ARRAY";
644            
645             # but might be a hashref, we just expand as a list
646             return %$args if $ref eq "HASH";
647            
648             # of it we've got a coderef, call it and return the results
649             return &$args if $ref eq "CODE";
650            
651             # anything else, just assume it's the only arg and return it!
652             warning funny_arglist "WARNING: suspicious arg-list given to PARSE (a single unrecognised $ref)";
653             return $args;
654             }
655            
656            
657            
658             #===========================================================================
659             #
660             # PARSE PARAMS
661             #
662             #===========================================================================
663            
664             sub parse
665             # Break up a parameter [list] into keys and subtypes
666             {
667             our $args;
668             my (@keys, @types, $i);
669             my $typesub; # Flag for handling TYPE types when we find them
670             my $subtype=pop; # Inner types start off as the outer-type
671            
672             debug 3, "Parsing params:", @_;
673             for my $p (array shift) # Loop through all the param keys sought
674             {
675             #Switch subtype whenever we hit one of our identifiers
676             if ($typesub) # previous item was a TYPE type, so look for the sub
677             {
678             push @keys, $p;
679             push @types, TYPE;
680             $i++;
681             $typesub=0;
682             debug 2, "\t", $p, "TYPE-sub";
683             }
684             elsif (same $p, TYPE)
685             {
686             $typesub=1; # set flag so next pass we can grab the type-sub
687             }
688             elsif (insame $p => POSN, NAME, FLAG) # we've hit one of our types
689             {
690             $subtype=$p; # switch current subtype-holder to that type
691             debug 2, "\t", $subtype, "subtype";
692             }
693             else #we've hit a param specifier, so build up our lists
694             {
695             my $t=typewriter $p, $subtype;
696             $p+=$args if $t==POSN && $p<0; # convert negative indices to the positive equivalent
697            
698             push @keys, $p;
699             push @types, $t;
700             $i++;
701             }
702             }
703            
704             warning orphaned_type "WARNING: Orphaned TYPE" if $typesub; # we found a TYPE but no type-sub was following it!
705            
706             return \@keys, \@types;
707             }
708            
709            
710            
711            
712             #===========================================================================
713             #
714             # POD
715             #
716             #===========================================================================
717              
718              
719             =head1 INTRODUCTION
720              
721             C is intended to provide a relatively simple and clean way to parse an argument list.
722             Perl subroutines typically assign the values of C<@_> to a list of variables, which is even simpler and cleaner,
723             but has the disadvantage that all the parameters are thus determined by position.
724             If you have optional parameters, or are worried about the order in which they might be passed
725             (it can be a pain to have to know the order when there are more than a couple of arguments),
726             it's much nicer to be able to use named arguments.
727              
728             The traditional way to pass a bunch of named arguments is to interpret C<@_> as a hash (a series of paired parameter names and values).
729             Easy, but you have to refer to your arguments via the hash, and you can't have
730             multiple parameters with the same name or any parameters that I named.
731             There are many modules that provide nifty mechanisms for much fancier arg processing;
732             however, they entail a certain amount of overhead to work their magic.
733             (Even in simple cases, they usually at least require extra punctuation or brackets.)
734              
735             C lacks various advanced features in favour of a minimal interface.
736             It's meant to be easy to learn and easier to use, covering the most common cases
737             in a way that keeps your code simple and obvious.
738             If you need something more powerful (or just think code should be as hard to read as it was to write (and real programmers know that it should!)),
739             then this module may not be for you.
740              
741             (C does have a few semi-advanced features, but you may need extra punctuation to use them.
742             (In some cases, even extra brackets.))
743              
744              
745              
746             =head1 DESCRIPTION
747              
748              
749             =head2 Basics
750              
751             In its simplest form, the B> function provided by C
752             takes a series of names or positions and returns the arguments
753             that correspond to those positions in C<@_>, or that are identified by those names.
754             The values are returned in the same order that you ask for them in the call to C.
755             C<@_> itself is never changed.
756             (Thus you could call C several times, if you wanted to for some reason.
757             You can also manipulate C<@_> before calling C.)
758              
759             marine("begin", bond=>007, "middle", smart=>86, "end");
760            
761             sub marine
762             {
763             my ($first, $last, $between, $maxwell, $james)=args 0,-1, 3, 'smart','bond';
764             #==>"begin" "end" "middle" 86 007
765            
766             my ($last, $max, $between, $first, $jim) = args(6, 'smart', -4, 0, 'bond');
767             #same thing in a different order
768             }
769              
770             By default, integers passed to C are taken to refer to positions in C<@_>, and
771             anything else is taken to be a name, or key, that returns the element following it if it is found in C<@_>.
772             (Note that you can use negative values to count backwards from the end of C<@_>.
773             If some values are too big or too small for the number of elements in C<@_>, undef is returned for those positions.)
774              
775             =for TODO: add a warning? probably off by default, but settable if you're worried about overshooting...
776              
777              
778             There is nothing special about the names as far as Perl is concerned: calling a function passes a list via C<@_> as always.
779             Then C loops through C<@_> and looks for matching elements; if it finds a match, the element of C<@_>
780             following the key is returned. If no match is found, undef is returned, and if multiple matches are found,
781             a reference is returned to an array containing all the appropriate values (in the order in which they occurred in C<@_>).
782              
783             human(darryl=>$brother, darryl=>$other_brother);
784            
785             sub human
786             {
787             my ($larry, $darryls) = args Larry, Darryl;
788             #==> undef [$brother, $other_brother]
789             }
790              
791             Keys are insensitive to case by default, but this is controlled by whether C<$Params::Clean::CaseSensitive> is true or not when C is called.
792              
793             =over 1
794              
795             =item
796              
797             Note that although C will let you mix named and positional arguments indiscriminately,
798             that doesn't mean it's a good idea, of course. It's not uncommon to have one or a few positional args
799             required at the beginning of a parameter list, followed by various (optional) named args. In particular,
800             methods always have the object passed as the argument in position 0.
801             It also might be reasonable sometimes to use fixed positions at the end of an arg list (since we can refer to them with negative positions).
802             Trying to mix named and positional params in the middle of your args, though, is asking for confusion.
803             (But many of the examples here do that for the sake of demonstrating how things work!)
804              
805             =back
806              
807              
808              
809             =head2 Specifying the argument list
810              
811             By default, C parses C<@_> to get the list of arguments. You can override this with the C keyword,
812             which takes a single value to be used for the args list. For example, C would explicitly get its arguments from C<@_>.
813             You can use any array-ref, or a hash-ref which will be flattened and treated as a plain list, or a code-ref which will be called and
814             the results used as the argument list.
815             Anything else will be used as a (single) argument value.
816              
817             The C keyword and its value must come immediately after C; putting other parameters before it will raise an error.
818              
819              
820              
821             =head2 POSN/NAME/FLAG identifiers
822              
823             You can also explicitly identify the kind of parameter using the keywords C or C.
824             This can be useful when you have, for example, keys that look like integers but that you want to treat as named keys.
825              
826             tract(1=>money, 2=>show, 3=>'get ready', Four, go);
827            
828             sub tract
829             {
830             my ($one, $two, $three, $four) = args NAME 1, 2, 3, four;
831             #==> money show get ready go
832            
833             #Without the NAMES identifier, the 1/2/3 would be interpreted as positions:
834             # $two would end up as "2" (the third element of @_), $three as "show", etc.
835             }
836              
837             Conversely, you could use the C keyword to force parameters to be interpreted positionally.
838             (Of course, most strings reduce to a numeric value of zero, which refers to the first position.)
839              
840             Besides named parameters, you can also pass Cs to a function
841             -- flags work like names,
842             except that they do not take their value from the following element of C<@_>; they simply become true
843             if they are found. More exactly, flags are counted; a flag returns C if it does not occur in C<@_>,
844             or returns the count of the number of times it was matched. (This allows you to handle flags
845             such as a "verbose" switch that can have a differing effect depending on how many times it was used.)
846              
847             scribe(black, white, red_all_over, black, jack, black);
848            
849             sub scribe
850             {
851             my ($raid, $surrender, $rule, $britannia)=args FLAG qw/black white union jack/;
852             #==> 3 1 undef 1
853             }
854              
855             The identifiers (C) can be mixed and repeated in any order, as desired.
856             The default integer/string distinction applies only until the first identifier is encountered;
857             once an identifier is used, it remains in effect until another identifier is found.
858             (Well, except in the case of I, as explained in the next section.)
859              
860              
861              
862             =head2 Alternative parameter names
863              
864             There may be situations where you want to mix different parameters together;
865             that is, return all the args named "foo" and all the args named "bar" in one set, as though they were all named "foo" (or all named "bar").
866             You can specify alternatives that should be treated as synonymous by putting them in square brackets (i.e., using an array-ref).
867             If a single match is found, it is grabbed; if there are more, they are all returned as an array-ref
868             (or in the case of a flag, it will be incremented as many times as there are matches).
869              
870             text(hey=>there, colour=>123, over=>here, color=>321);
871            
872             sub text
873             {
874             my ($horses, $hues, $others)
875             =args [hey, hay], [colour, color], [4, 5];
876             #===> there [123, 321] [over, here]
877             }
878              
879             As the example shows, this also works for positional parameters, so you can return multiple positions as a single arg too.
880             Like any parameters, synonyms are by default positional (if numeric) or named (if not);
881             they are also affected normally by any identifier (C/C/C) that precedes them.
882             If you specify an identifier B the alternatives, the brackets provide a limited scope,
883             so the identifier does not extend to any parameters outside the list of alternatives.
884              
885             lime(alpha, Jack=>"B. Nimble", verbosity, verbosity);
886            
887             sub lime
888             {
889             my ($start, $verb, $water_bearer, $pomp)
890             =args [0, FIRST], FLAG verbosity, [NAME Jack, Jill], pomposity;
891             #===> alpha 2 B. Nimble
892             }
893              
894             Without the C identifier, "Jack" and "Jill" would be parsed as flags;
895             if the C came in front of the opening bracket instead of inside it, "pomposity" would also be considered a C instead of a C.
896             (There's nothing to say a list of synonyms can't contain only one item; so you might say
897             C<[FLAG foo]> to identify that single parameter as a flag without affecting the parameters that follow it.)
898              
899             The order of the synonyms is irrelevant; once keys are declared as alternatives for each other,
900             C sees no difference between them. All the args that match a given key or keys are
901             returned in the order in which they occur in C<@_>.
902              
903              
904              
905             =head2 The REST
906              
907             Another keyword C understands is C, to return any elements of C<@_> that are left over
908             after all the other kinds of parameters have been parsed.
909             The leftovers are not grouped into an array-ref; they are simply returned as a list of items coming after the other args.
910              
911             $I->conscious(earth, sky, plants, sun, fish, animals, holiday);
912            
913             sub conscious
914             {
915             ($self, @days[1..6], @sabbath) = args 0, 1..6, REST;
916             }
917              
918             Although the REST identifier can appear anywhere in the call to C, the remaining arguments are always returned last.
919             (If warnings are turned on, C will complain about C not being specified last.
920             (There wouldn't be any point to returning the leftover values in the middle of the other arguments anyway,
921             since you don't know how many there are. (And if you really do know, then just use positionals instead.)))
922              
923             =for TODO ### What if we allow [REST] to return as arrayref instead of loose? -- and then you could put it anywhere; or also do [foo, 1, REST]?
924              
925              
926              
927             =head2 Identifying args by type
928              
929             As well as by name or position, C can also gather parameters by type.
930             For instance, you can collect any array-refs passed to your function by asking for C.
931             C checks the C of each argument, so you can select any built-in reference (C),
932             or the name of a class to grab all objects of a certain type.
933              
934             #Assume we have created some filehandle objects with a module like IO::All
935             version($INPUT, $OUTPUT, some, random, stuff, $LOGFILE);
936            
937             sub version
938             {
939             my ($files, @leftovers) = args TYPE "IO::All", REST;
940             #===> [$INPUT, $OUTPUT, $LOGFILE], some, random, stuff
941             }
942              
943             C can also take a code-ref for more complex conditions.
944             Each argument will be passed to the code block, and it must return true or false according to whether the arg qualifies.
945              
946             stance(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, oops, 13, 2048);
947            
948             sub Even { $_=shift; return $_ && /^\d+$/ && $_%2==0 }
949             # check whether the given value looks like an int and is even
950            
951             sub stance
952             {
953             my ($odds, $evens, @others)
954             = args TYPE sub {shift()%2}, TYPE \&Even, REST;
955             # one inline code-ref and one ref to a sub
956            
957             #===> [1,3,5,7,9,13], [2,4,6,8,10,2048], oops
958             }
959              
960             Note that since all the args are passed to our TYPE functions, that "oops" is going to cause a warning
961             about not being numeric when the odd-number coderef simply attempts to C<% 2> it.
962             The C sub is better behaved: it first checks (with the regex) whether it's got something that looks like a number.
963             Since you never know what kind of arguments might get passed in, C blocks should always take appropriate precautions.
964              
965             Also note that C functions do not validate the arguments. Although the code block can be quite complex,
966             it doesn't reject anything; args that don't pass the test are simply not collected for that parameter.
967              
968              
969              
970             =head2 Lists
971              
972             =head3 Absolute lists
973              
974             It is possible to collect a C of arguments starting from a certain name or position,
975             and grabbing all the args that follow it up to an ending name or position.
976             If the end point cannot be found (e.g., we run out of args because there aren't any more, or because
977             we've reached an arg that was already grabbed by some previous parameter), the list stops.
978             If the end point is found, you can choose to include it in the list of args, or to exclude it
979             (in which case, the list will consist of the args from the starting point to the one just before the end point).
980              
981             dominant(some, stuff, Start=> C, G, A, E, F, C, End, something, else);
982            
983             sub dominant
984             {
985             my ($notes, @rest) = args LIST Start<=>End, REST; # including end point
986             #===> [Start,C,G,A,E,F,C,End], some, stuff, something, else
987            
988             my ($notes, @rest) = args LIST Start<=End, REST; # excluding end point
989             #===> [Start,C,G,A,E,F,C], some, stuff, End, something, else
990             }
991              
992             The C keyword is followed by a parameter name or position to start from.
993             An ending parameter is not required (the list will go until the end of the arg list,
994             or until hitting an argument that was already collected).
995             Use C<< <=> >> after the starting parameter key to indicate that the following end-point
996             should be included in the resulting list; use C<< <= >> to indicate that it should not.
997             (The starting argument is always included -- if you don't want it, you can always C
998             it off the front of the list later.)
999              
1000              
1001             Excluding the end-points from a list can be useful when you want to indicate that a list should stop where something else begins.
1002             The following example has three Cs, where the end of one is the start of the next; if each list included its end-point,
1003             then the starting-point for the next list would already be used up, and C wouldn't see it.
1004              
1005             query(SELECT=>@fields, FROM=>$table, WHERE=>@conditions);
1006            
1007             sub query
1008             {
1009             my ($select, $from, $where)
1010             = args LIST SELECT<=FROM, LIST FROM<=WHERE, LIST WHERE; #explicit endings
1011             #===> [SELECT, @fields], [FROM, $table], [WHERE, @conditions]
1012            
1013             # But this is not what we want -- the first list grabs everything:
1014             = args LIST SELECT, LIST FROM, LIST WHERE; #oops!
1015             #===> [SELECT, @fields, FROM, $table, WHERE, @conditions], undef, undef
1016            
1017            
1018             my ($where, $from, $select) # note the reversed order
1019             = args LIST WHERE, LIST FROM, LIST SELECT; #this is OK
1020             #===> [WHERE, @conditions], [FROM, $table], [SELECT, @fields]
1021             }
1022              
1023             The middle part of the example shows that even though it's not necessary to specify an ending for a list,
1024             without one the argument-gathering might run amok.
1025             The last part illustrates how lists stop when they run out of ungathered args, even if the end-point hasn't been reached.
1026             By collecting the C list first, the C list is forced to stop when it reaches the last arg preceding the C,
1027             and similarly the C
1028             (See also L<"Using up arguments">.)
1029              
1030              
1031              
1032             =head3 Relative lists
1033              
1034             Specifying the starting and ending points for a list gives absolute bounds for the list.
1035             Lists can also be relative; that is, specifying the desired positions surrounding the starting key.
1036             The starting point itself represents position zero, and you can choose args before or after it.
1037             You can specify just a single position to grab, but usually you will want to grab several positions, using the "alternatives" syntax [brackets/array-ref].
1038             (However, you may not specify NAMEd params or FLAGs; a relative list can collect only args positionally relative to the starting parameter.)
1039              
1040             merge(black =>vs=> white);
1041            
1042             sub merge
1043             {
1044             my ($spys) = args LIST vs=[-1, 1];
1045             #===> [black, white] # -1=posn before "vs", +1=posn after "vs"
1046             }
1047              
1048             Use C<=> after the starting point to specify exactly what positions to collect (include position C<0> to grab the starting parameter too);
1049             use C<&> followed by the positions to collect them as well as the the starting point itself (without having to include position C<0> explicitly);
1050             use C<^> to collect positions but exclude the starting point itself (even if C<0> is included in the positions given).
1051             This lets you say things like C ^ [-3..+3]> instead of spelling it out explicitly without the C<0>: C = [-3. -2. -1. 1. 2. 3]>.
1052             (The symbol used for the exclusive case is the same character that Perl uses for I-or.)
1053              
1054             due(First=>$a, $b, $c, Second=>$d, $e, Third=>$f);
1055            
1056             sub due
1057             {
1058             my ($first, $second, $third)
1059             = args LIST First=[1,2,3], LIST Second & 2, LIST Third^[-1..+1];
1060             #===> [$a, $b, $c], [Second, $e], [$e, $f]
1061             }
1062              
1063             As shown, a relative list can take a just a single position, in which case the brackets are optional: C or C.
1064              
1065              
1066             =head3 General notes about lists
1067              
1068             You can mix positionals and named parameters in the starting point for any list, or for the ending point of an absolute C
1069             in the expected way (using brackets/array-refs for alternatives):
1070              
1071             let(foo, Color=> $red, $green, $blue, Begin=>@scrabble=>Stop, bar);
1072            
1073             sub let
1074             {
1075             my ($rgb, $tiles, @rest)
1076             = args LIST [Colour,Color]=[1,2,3], LIST [Start,Begin]<=>[Stop,-1], REST;
1077             #===> [$red,$green,$blue], [Begin,@scrabble,Stop], foo, bar
1078             }
1079              
1080             (In this example, the second list will end when it finds the string C or reaches the last (C<-1>) position;
1081             the first element of the list will be whichever parameter was found
1082             -- in this case, "C").
1083              
1084             If the starting key for a list appears more than once, the first occurrence (that has not already been used) will match.
1085             So calling C<< some_func(FOO=>a,b,c. FOO=>x,y,z) >> could produce two lists with, e.g., C<< args LIST FOO=[1,2,3], LIST FOOE=>[-1] >>.
1086              
1087             Unlike the other kinds of parameter (which return a single scalar or an array-ref if multiple matches are found),
1088             lists always return an array-ref, even though it might contain only one arg.
1089             (Calling it a "list" implies you're expecting more than one result
1090             -- if you're not, you can simply use a C or C instead.)
1091             The exception is that if the list runs into a problem (e.g. cannot find a legitimate starting point), it will return C.
1092              
1093              
1094              
1095             =head2 Using up arguments
1096              
1097             Every time an argument is found, C marks it as used.
1098             Used arguments are not checked again, regardless of whether they could match other parameters or not.
1099              
1100             side(left=>right);
1101            
1102             sub side
1103             {
1104             my ($dextrous, $sinister, @others) = args NAME left, FLAG left, REST;
1105             #===> right undef ()
1106             #"left" was not found as a FLAG because it was already used as a NAME
1107            
1108             # But...
1109            
1110             my ($sinister, $dextrous, @others) = args FLAG left, NAME left, REST;
1111             #===> 1 undef right
1112             #now "left" was not found as a NAME because it was found first as a FLAG
1113             }
1114              
1115             Note that the second case, the argument "C" was found as a leftover (C), because it did not get collected by the other parameters.
1116             Since the "C" argument was found and used as a C, it was no longer available to be used as a C, and so nothing happened to
1117             the arg (C) that it was meant to be a name for.
1118              
1119             It is possible to collect the same value more than once, however.
1120             This can happen when the parameter that C is searching for has not been used yet, even though an arg that parameter points to already has.
1121             For example, this next example gets the C<$fh> argument from all three parameters:
1122              
1123             #Assume that $fh is a filehandle,
1124             # and &handle() returns true when it identifies a filehandle
1125            
1126             tend(Input=>$fh, Pipe "/dev/null");
1127            
1128             sub tend
1129             {
1130             my ($file, $input, $pipe)=args TYPE \&handle, NAME Input, LIST Pipe=[-1, 1];
1131             #===> $fh, $fh, [$fh, /dev/null]
1132             }
1133              
1134             First, C searches by type for any args that satisfy the C function, so it grabs C<$fh> for the first parameter, C<$file>.
1135             Next, C looks for an argument identified by the name C; the first element of C<@_> is indeed "C", so it gets the following element of C<@_>.
1136             (That second element has already been used to get the C<$file>, but the I has not yet been used, so it still qualifies.
1137             Once the name has been found, the collected arg is always what comes immediately after it
1138             -- for example, C will not grab the I element after the name just because the first value after was already used.)
1139             Finally, the relative list successfully identifies the C label, so it takes the preceding and succeeding elements of C<@_> (relative positions -1 and +1).
1140             Again, once C is found, it does not matter whether the values identified by the positions have been used already or not.
1141             (However, recall that for an absolute list, a used argument will stop processing the list,
1142             even if that means the list consists of nothing but the starting point.)
1143              
1144              
1145             =head2 Care and C of your module
1146              
1147             You can simply C, or you can supply some extra options to control warnings and exported names.
1148             The options are a series of keys and values (so they must be correctly paired).
1149              
1150             To change the name under which a keyword will be exported into your namespace, give its default name followed by
1151             the name you wish to use for it in your calling module, e.g. if you already have a C function, you can rename
1152             C's C by including an option like C<< LIST=>PLIST >>.
1153              
1154             You can also control how C will handle various kinds of errors. Most exceptions simply emit a warning
1155             message and try to continue. You can set the level for recognised categories to "warn" to display a message;
1156             to "die" or "fatal" to display the message and die; or to "ignore" to do nothing.
1157             Give the level of error-handling followed by the category name, e.g. C<< die=>missing_start >>.
1158             See L for the names of each category, and the default level.
1159              
1160             Example:
1161              
1162             use Params::Clean LIST=>"PLIST", NAME=>"Key", fatal=>"misplaced_rest";
1163              
1164             C will issue a warning for any unrecognised options that it encounters. (You can C<< ignore=>invalid_opts >>,
1165             but of course that will affect only subsequent options, not any that came before it.)
1166              
1167              
1168              
1169             =head1 UIDs
1170              
1171             Perl cannot tell a parameter name (or flag or list boundary) from any other argument passed to a subroutine.
1172             If someone passes an arg with a value of "date" to your sub (e.g., C<< lunch(fruit=>"date", date=>"tomorrow") >>),
1173             and it is looking for a parameter called "date" (e.g., C),
1174             it will match the first occurrence (e.g., C<$when> will find the first C string and get as its value what comes next, which is the second C)
1175             -- unless you can be sure that there will be no confusion;
1176             for example, because that arg will be caught as one of the positional params and thus ignored by any subsequent FLAG or NAME or LIST parts of the process.
1177              
1178             Of course, it is difficult to guarantee that no such confusion will arise; even if the values that could be ambiguous don't make sense,
1179             you can't stop somebody from calling your function with nonsensical arguments!
1180             What is possible, though, is to avoid using ordinary strings for parameters names (or flags, etc.).
1181             The L module is useful in this respect: it creates unique identifier objects that cannot be duplicated accidentally.
1182             (You can deliberately copy one, of course; but you cannot create separate UIDs that would match each other.)
1183             Thus if you use UIDs for your parameter flags, you do not have to worry about your caller (accidentally!) passing a value that could be a false positive.
1184              
1185             use UID Stop; # create a unique ID
1186             way(Delimiter=>"Stop", Stop "Morningside Crescent");
1187            
1188             sub way
1189             {
1190             my ($tube, $telegram) = args Stop, Delimiter;
1191             #===>"Morningside Crescent", "Stop"
1192             }
1193              
1194             When C is looking for the parameter name C, it will not find the plain string "Stop"
1195             -- only a UID object (in fact, the same UID object) will do.
1196             Note also that a UID doesn't (usually) require a comma between it and the following value.
1197              
1198             Of course, if you are exporting a function for other packages to use, you will probably want to export any UIDs that go along with it
1199             (otherwise the UIDs will have to be fully-qualified to use them from another package, e.g., C).
1200             The same considerations apply as for exporting any other subroutine
1201             -- allow the user control over what gets exported to avoid conflicts from different modules trying to export UIDs of the same name.
1202              
1203             C exports UIDs for its identifiers (C) so that you can use them with the C function in your subroutines.
1204             (They can be renamed for importing into your namespace: see L<"Care and Usage of your module">).
1205              
1206              
1207              
1208              
1209             =head1 DIAGNOSTICS
1210              
1211             The list below includes the category of each exception, so that you can control how C handles that type
1212             of exception, e.g. C<< warn=>foo >> means that any "foo" errors will issue a warning by default.
1213             (See L<"Care and Usage of your module">).
1214              
1215              
1216             =over 1
1217              
1218             =item I
1219              
1220             =item I
1221              
1222             Binvalid_opts >>>
1223              
1224             An option (pair) given in the C statement is invalid, misspelled, or otherwise not recognised by C.
1225             The unknown option will be skipped over.
1226              
1227              
1228             =item I
1229              
1230             Bmisplaced_parse >>>
1231              
1232             When explcitly giving a list of arguments to parse, the C keyword must be the first thing passed to C.
1233             By default, C will die when it finds a C command out of place;
1234             if you set it to C or C, the value passed in via C will be ignored
1235             (and if you have set C<< warn=>misplaced_parse >>, you will get a "B" message).
1236              
1237              
1238             =item I
1239              
1240             Bfunny_arglist >>>
1241              
1242             The value you pass in for an argument list using C should be an arrayref, or a hashref, or a coderef.
1243             Anything else will trigger this warning, if you turn it on.
1244              
1245              
1246             =item I
1247              
1248             Bmisplaced_rest >>>
1249              
1250             The C keyword was not the last item passed to C. The leftover values are always returned after everything else,
1251             so C should appear last to avoid confusion.
1252              
1253              
1254             =item I[orI< ending>]I< param key: $key>
1255              
1256             =item I[orI< ending>]I< param key: $key>
1257              
1258             Binvalid_list >>>
1259              
1260             A C can take only named or positional parameters as the starting (or ending) point.
1261             Something like C<< LIST [FLAG Foo] <=> [TYPE \&foo] >> will trigger a warning for either the starting or ending point (or both).
1262             An invalid starting point means nothing will be returned for the list (C);
1263             an invalid ending point means that only the starting key will be returned; no other args will be collected.
1264              
1265              
1266             =item I
1267              
1268             =item I
1269              
1270             Bmissing_start >>>
1271              
1272             Bmissing_end >>>
1273              
1274             The starting or ending parameter specified for a LIST could not be found.
1275             If the given parameter does appear somewhere in C<@_>, the message will also say, I<"(probably already used up by another param!)">
1276             (meaning a previously-collected arg already marked that parameter as "used" -- see L<"Using up arguments">).
1277             If the starting point cannot be found, then nothing (C) is returned for the list (surprisingly enough).
1278             If the ending point cannot be found, then everything else (not already collected) until the end of C<@_> will be grabbed by the list.
1279             To deliberately allow a list to run off the end of C<@_>, make C<-1> (one of) the ending keys, or else do not specify an ending point at all.
1280              
1281              
1282             =item I
1283              
1284             Binvalid_type >>>
1285              
1286             C parameters must be the name of a class (a C value), or a code-ref that can check each arg.
1287             Trying to use anything else as a C (e.g. a plain number or string) will result in this error.
1288              
1289              
1290             =item I
1291              
1292             Bnonint_name >>>
1293              
1294             A number that's not an integer was found as a parameter key. Since positional params must be integers,
1295             the value will be interpreted as a Cd parameter. To avoid the error, explicitly mark the key using the C keyword.
1296              
1297              
1298             =item I
1299              
1300             Borphaned_type >>>
1301              
1302             A C keyword was encountered without a following string or coderef, e.g., C.
1303              
1304              
1305             =back
1306              
1307              
1308              
1309             =head1 BUGS & OTHER ANNOYANCES
1310              
1311             There are no known bugs at the moment. (That's what they all say!)
1312             Please report any problems you may find, or any other feedback, to Cbug-params-clean at rt.cpan.orgE>,
1313             or through the web interface at L.
1314              
1315              
1316             Using C, variables are not right next to the parameter identifiers they are assigned from.
1317             It probably helps to line up the variables and the call to C if you have more than a few parameters,
1318             so that you can see what matches up with what:
1319              
1320             my ($foo, $bar, $baz)
1321             = args(foo, POSN -1, FLAG on)
1322              
1323              
1324             Defaults must be set in a separate step after parsing the parameters with C (e.g., C<$foo||=$default;>).
1325              
1326              
1327             C<@_> is aliased to the actual calling parameters, that is, changing C<@_> will change the original variables
1328             passed to the function. Variables assigned from a call to C are of course copies rather than aliases.
1329             C<@_> can be used directly, although if you're making the effort to use named parameters, you can require the
1330             caller to pass in references to the original variables where appropriate.
1331              
1332              
1333             The special identifiers (C, C, etc.) are UID objects, and UID objects are really functions,
1334             so C<< NAME=>foo >> will not work; the C<< => >> auto-quotes the preceding bareword, even when the "bareword" is really meant to call a sub.
1335             Fortunately, you can usually simply say C instead. See the documentation for C> for further details and caveats.
1336              
1337              
1338             If a named parameter (or position) does not appear in the argument list, then C will return C for it
1339             -- just as if someone had explicitly specified a parameter with that name and passed it a value of C.
1340             Thus there is no way to tell the difference between a deliberate value of C and a parameter that is simply missing altogether.
1341             However, you could force an extra argument of that name into C<@_> before parsing it with C;
1342             if the parameter was missing altogether, your dummy value will be the only one returned;
1343             if you get back multiple values, you know that others were explicitly passed for that parameter.
1344              
1345              
1346             The examples given here use lots of barewords. Omitting all those quotation marks makes them look cleaner,
1347             but any real program, with C and C in effect, will need to quote everything,
1348             even if it does add slightly to the clutter. Judicious use of C<< => >> to quote the preceding word can help, as can defining Ls.
1349              
1350              
1351             Cs cannot identify starting (or ending) points by C. They probably should be able to.
1352              
1353              
1354             Additional or more helpful diagnostics would be nice.
1355              
1356              
1357             Sometimes, trying to read C<@_> automatically seems not to work. If this happens, the simple workaround is to explicitly
1358             specify C as the first thing passed to C.
1359             (And if you know what makes Devel::Caller::Perl's C function sometimes unable to read C<@_>, please let me know!)
1360              
1361              
1362             To paraphrase L:
1363             It shouldn't take hundreds and hundreds of lines to explain a package that was designed for intuitive ease of use!
1364              
1365              
1366              
1367             =head1 RELATED MODULES
1368              
1369             This module requires L and L.
1370              
1371             =for TODO: see also other modules?
1372              
1373              
1374              
1375             =head1 METADATA
1376              
1377             Copyright 2007-2008 David Green, C<< >>.
1378              
1379             This module is free software; you may redistribute it or modify it under the same terms as Perl itself. See L.
1380              
1381             =cut
1382              
1383              
1384              
1385             AYPWIP: "I think so, Brain, but I get all clammy inside the tent!"