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 list stops with the last element of C<@fields>, since the subsequent C has already been used.
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!"