Commit | Line | Data |
---|---|---|
a11f5414 | 1 | # GetOpt::Long.pm -- Universal options parsing |
404cbe93 | 2 | |
a11f5414 JV |
3 | package Getopt::Long; |
4 | ||
1a505819 | 5 | # RCS Status : $Id: GetoptLong.pl,v 2.21 1999-08-04 10:33:07+02 jv Exp $ |
404cbe93 | 6 | # Author : Johan Vromans |
7 | # Created On : Tue Sep 11 15:00:12 1990 | |
8 | # Last Modified By: Johan Vromans | |
1a505819 GS |
9 | # Last Modified On: Wed Aug 4 10:08:50 1999 |
10 | # Update Count : 709 | |
404cbe93 | 11 | # Status : Released |
12 | ||
bb40d378 | 13 | ################ Copyright ################ |
f06db76b | 14 | |
f9a400e4 | 15 | # This program is Copyright 1990,1999 by Johan Vromans. |
bb40d378 | 16 | # This program is free software; you can redistribute it and/or |
1a505819 GS |
17 | # modify it under the terms of the Perl Artistic License or the |
18 | # GNU General Public License as published by the Free Software | |
19 | # Foundation; either version 2 of the License, or (at your option) any | |
20 | # later version. | |
21 | # | |
bb40d378 JV |
22 | # This program is distributed in the hope that it will be useful, |
23 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
24 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
25 | # GNU General Public License for more details. | |
26 | # | |
27 | # If you do not have a copy of the GNU General Public License write to | |
f9a400e4 JH |
28 | # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, |
29 | # MA 02139, USA. | |
f06db76b | 30 | |
bb40d378 | 31 | ################ Module Preamble ################ |
404cbe93 | 32 | |
bb40d378 | 33 | use strict; |
404cbe93 | 34 | |
bb40d378 | 35 | BEGIN { |
3a0431da | 36 | require 5.004; |
bb40d378 | 37 | use Exporter (); |
e6d5c530 | 38 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); |
1a505819 | 39 | $VERSION = "2.20"; |
e6d5c530 JV |
40 | |
41 | @ISA = qw(Exporter); | |
42 | @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); | |
43 | %EXPORT_TAGS = qw(); | |
44 | @EXPORT_OK = qw(); | |
45 | use AutoLoader qw(AUTOLOAD); | |
bb40d378 | 46 | } |
404cbe93 | 47 | |
bb40d378 | 48 | # User visible variables. |
e6d5c530 | 49 | use vars @EXPORT, @EXPORT_OK; |
bb40d378 JV |
50 | use vars qw($error $debug $major_version $minor_version); |
51 | # Deprecated visible variables. | |
52 | use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order | |
53 | $passthrough); | |
e6d5c530 JV |
54 | # Official invisible variables. |
55 | use vars qw($genprefix); | |
56 | ||
57 | # Public subroutines. | |
58 | sub Configure (@); | |
59 | sub config (@); # deprecated name | |
60 | sub GetOptions; | |
61 | ||
62 | # Private subroutines. | |
63 | sub ConfigDefaults (); | |
64 | sub FindOption ($$$$$$$); | |
65 | sub Croak (@); # demand loading the real Croak | |
404cbe93 | 66 | |
bb40d378 | 67 | ################ Local Variables ################ |
404cbe93 | 68 | |
e6d5c530 JV |
69 | ################ Resident subroutines ################ |
70 | ||
71 | sub ConfigDefaults () { | |
72 | # Handle POSIX compliancy. | |
73 | if ( defined $ENV{"POSIXLY_CORRECT"} ) { | |
74 | $genprefix = "(--|-)"; | |
75 | $autoabbrev = 0; # no automatic abbrev of options | |
76 | $bundling = 0; # no bundling of single letter switches | |
77 | $getopt_compat = 0; # disallow '+' to start options | |
78 | $order = $REQUIRE_ORDER; | |
79 | } | |
80 | else { | |
81 | $genprefix = "(--|-|\\+)"; | |
82 | $autoabbrev = 1; # automatic abbrev of options | |
83 | $bundling = 0; # bundling off by default | |
84 | $getopt_compat = 1; # allow '+' to start options | |
85 | $order = $PERMUTE; | |
86 | } | |
87 | # Other configurable settings. | |
88 | $debug = 0; # for debugging | |
89 | $error = 0; # error tally | |
90 | $ignorecase = 1; # ignore case when matching options | |
91 | $passthrough = 0; # leave unrecognized options alone | |
92 | } | |
93 | ||
94 | ################ Initialization ################ | |
95 | ||
96 | # Values for $order. See GNU getopt.c for details. | |
97 | ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); | |
98 | # Version major/minor numbers. | |
99 | ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/; | |
100 | ||
101 | # Set defaults. | |
102 | ConfigDefaults (); | |
103 | ||
104 | ################ Package return ################ | |
105 | ||
106 | 1; | |
107 | ||
108 | __END__ | |
109 | ||
110 | ################ AutoLoading subroutines ################ | |
111 | ||
1a505819 | 112 | # RCS Status : $Id: GetoptLongAl.pl,v 2.22 1999-07-07 12:57:05+02 jv Exp $ |
e6d5c530 JV |
113 | # Author : Johan Vromans |
114 | # Created On : Fri Mar 27 11:50:30 1998 | |
115 | # Last Modified By: Johan Vromans | |
1a505819 GS |
116 | # Last Modified On: Wed Jul 7 12:47:57 1999 |
117 | # Update Count : 28 | |
e6d5c530 | 118 | # Status : Released |
404cbe93 | 119 | |
bb40d378 | 120 | sub GetOptions { |
404cbe93 | 121 | |
bb40d378 | 122 | my @optionlist = @_; # local copy of the option descriptions |
e6d5c530 JV |
123 | my $argend = '--'; # option list terminator |
124 | my %opctl = (); # table of arg.specs (long and abbrevs) | |
125 | my %bopctl = (); # table of arg.specs (bundles) | |
126 | my $pkg = (caller)[0]; # current context | |
bb40d378 | 127 | # Needed if linkage is omitted. |
e6d5c530 | 128 | my %aliases= (); # alias table |
bb40d378 JV |
129 | my @ret = (); # accum for non-options |
130 | my %linkage; # linkage | |
131 | my $userlinkage; # user supplied HASH | |
e6d5c530 JV |
132 | my $opt; # current option |
133 | my $genprefix = $genprefix; # so we can call the same module many times | |
134 | my @opctl; # the possible long option names | |
135 | ||
bb40d378 | 136 | $error = ''; |
404cbe93 | 137 | |
e6d5c530 JV |
138 | print STDERR ("GetOpt::Long $Getopt::Long::VERSION ", |
139 | "called from package \"$pkg\".", | |
140 | "\n ", | |
1a505819 | 141 | 'GetOptionsAl $Revision: 2.22 $ ', |
e6d5c530 JV |
142 | "\n ", |
143 | "ARGV: (@ARGV)", | |
144 | "\n ", | |
145 | "autoabbrev=$autoabbrev,". | |
146 | "bundling=$bundling,", | |
147 | "getopt_compat=$getopt_compat,", | |
148 | "order=$order,", | |
149 | "\n ", | |
150 | "ignorecase=$ignorecase,", | |
151 | "passthrough=$passthrough,", | |
152 | "genprefix=\"$genprefix\".", | |
153 | "\n") | |
bb40d378 | 154 | if $debug; |
404cbe93 | 155 | |
bb40d378 JV |
156 | # Check for ref HASH as first argument. |
157 | # First argument may be an object. It's OK to use this as long | |
158 | # as it is really a hash underneath. | |
159 | $userlinkage = undef; | |
160 | if ( ref($optionlist[0]) and | |
161 | "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) { | |
162 | $userlinkage = shift (@optionlist); | |
163 | print STDERR ("=> user linkage: $userlinkage\n") if $debug; | |
164 | } | |
404cbe93 | 165 | |
bb40d378 JV |
166 | # See if the first element of the optionlist contains option |
167 | # starter characters. | |
1a505819 GS |
168 | # Be careful not to interpret '<>' as option starters. |
169 | if ( $optionlist[0] =~ /^\W+$/ | |
170 | && !($optionlist[0] eq '<>' | |
171 | && @optionlist > 0 | |
172 | && ref($optionlist[1])) ) { | |
bb40d378 JV |
173 | $genprefix = shift (@optionlist); |
174 | # Turn into regexp. Needs to be parenthesized! | |
175 | $genprefix =~ s/(\W)/\\$1/g; | |
176 | $genprefix = "([" . $genprefix . "])"; | |
177 | } | |
404cbe93 | 178 | |
bb40d378 JV |
179 | # Verify correctness of optionlist. |
180 | %opctl = (); | |
181 | %bopctl = (); | |
182 | while ( @optionlist > 0 ) { | |
183 | my $opt = shift (@optionlist); | |
404cbe93 | 184 | |
bb40d378 | 185 | # Strip leading prefix so people can specify "--foo=i" if they like. |
3a0431da | 186 | $opt = $+ if $opt =~ /^$genprefix+(.*)$/s; |
404cbe93 | 187 | |
bb40d378 JV |
188 | if ( $opt eq '<>' ) { |
189 | if ( (defined $userlinkage) | |
190 | && !(@optionlist > 0 && ref($optionlist[0])) | |
191 | && (exists $userlinkage->{$opt}) | |
192 | && ref($userlinkage->{$opt}) ) { | |
193 | unshift (@optionlist, $userlinkage->{$opt}); | |
194 | } | |
195 | unless ( @optionlist > 0 | |
196 | && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { | |
197 | $error .= "Option spec <> requires a reference to a subroutine\n"; | |
198 | next; | |
199 | } | |
200 | $linkage{'<>'} = shift (@optionlist); | |
201 | next; | |
202 | } | |
404cbe93 | 203 | |
bb40d378 | 204 | # Match option spec. Allow '?' as an alias. |
e6d5c530 | 205 | if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) { |
bb40d378 JV |
206 | $error .= "Error in option spec: \"$opt\"\n"; |
207 | next; | |
208 | } | |
209 | my ($o, $c, $a) = ($1, $5); | |
210 | $c = '' unless defined $c; | |
404cbe93 | 211 | |
bb40d378 JV |
212 | if ( ! defined $o ) { |
213 | # empty -> '-' option | |
214 | $opctl{$o = ''} = $c; | |
215 | } | |
216 | else { | |
217 | # Handle alias names | |
218 | my @o = split (/\|/, $o); | |
219 | my $linko = $o = $o[0]; | |
220 | # Force an alias if the option name is not locase. | |
221 | $a = $o unless $o eq lc($o); | |
222 | $o = lc ($o) | |
223 | if $ignorecase > 1 | |
224 | || ($ignorecase | |
225 | && ($bundling ? length($o) > 1 : 1)); | |
404cbe93 | 226 | |
bb40d378 JV |
227 | foreach ( @o ) { |
228 | if ( $bundling && length($_) == 1 ) { | |
229 | $_ = lc ($_) if $ignorecase > 1; | |
230 | if ( $c eq '!' ) { | |
231 | $opctl{"no$_"} = $c; | |
232 | warn ("Ignoring '!' modifier for short option $_\n"); | |
233 | $c = ''; | |
234 | } | |
235 | $opctl{$_} = $bopctl{$_} = $c; | |
236 | } | |
237 | else { | |
238 | $_ = lc ($_) if $ignorecase; | |
239 | if ( $c eq '!' ) { | |
240 | $opctl{"no$_"} = $c; | |
241 | $c = ''; | |
242 | } | |
243 | $opctl{$_} = $c; | |
244 | } | |
245 | if ( defined $a ) { | |
246 | # Note alias. | |
247 | $aliases{$_} = $a; | |
248 | } | |
249 | else { | |
250 | # Set primary name. | |
251 | $a = $_; | |
252 | } | |
253 | } | |
254 | $o = $linko; | |
255 | } | |
404cbe93 | 256 | |
bb40d378 JV |
257 | # If no linkage is supplied in the @optionlist, copy it from |
258 | # the userlinkage if available. | |
259 | if ( defined $userlinkage ) { | |
260 | unless ( @optionlist > 0 && ref($optionlist[0]) ) { | |
261 | if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) { | |
262 | print STDERR ("=> found userlinkage for \"$o\": ", | |
263 | "$userlinkage->{$o}\n") | |
264 | if $debug; | |
265 | unshift (@optionlist, $userlinkage->{$o}); | |
266 | } | |
267 | else { | |
268 | # Do nothing. Being undefined will be handled later. | |
269 | next; | |
270 | } | |
271 | } | |
272 | } | |
404cbe93 | 273 | |
bb40d378 JV |
274 | # Copy the linkage. If omitted, link to global variable. |
275 | if ( @optionlist > 0 && ref($optionlist[0]) ) { | |
276 | print STDERR ("=> link \"$o\" to $optionlist[0]\n") | |
277 | if $debug; | |
278 | if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) { | |
279 | $linkage{$o} = shift (@optionlist); | |
280 | } | |
281 | elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) { | |
282 | $linkage{$o} = shift (@optionlist); | |
283 | $opctl{$o} .= '@' | |
284 | if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/; | |
285 | $bopctl{$o} .= '@' | |
286 | if $bundling and defined $bopctl{$o} and | |
287 | $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/; | |
288 | } | |
289 | elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) { | |
290 | $linkage{$o} = shift (@optionlist); | |
291 | $opctl{$o} .= '%' | |
292 | if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/; | |
293 | $bopctl{$o} .= '%' | |
294 | if $bundling and defined $bopctl{$o} and | |
295 | $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/; | |
296 | } | |
297 | else { | |
298 | $error .= "Invalid option linkage for \"$opt\"\n"; | |
299 | } | |
300 | } | |
301 | else { | |
302 | # Link to global $opt_XXX variable. | |
303 | # Make sure a valid perl identifier results. | |
304 | my $ov = $o; | |
305 | $ov =~ s/\W/_/g; | |
306 | if ( $c =~ /@/ ) { | |
307 | print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n") | |
308 | if $debug; | |
309 | eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;"); | |
310 | } | |
311 | elsif ( $c =~ /%/ ) { | |
312 | print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n") | |
313 | if $debug; | |
314 | eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;"); | |
315 | } | |
316 | else { | |
317 | print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n") | |
318 | if $debug; | |
319 | eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;"); | |
320 | } | |
321 | } | |
322 | } | |
323 | ||
324 | # Bail out if errors found. | |
325 | die ($error) if $error; | |
326 | $error = 0; | |
327 | ||
328 | # Sort the possible long option names. | |
329 | @opctl = sort(keys (%opctl)) if $autoabbrev; | |
330 | ||
331 | # Show the options tables if debugging. | |
332 | if ( $debug ) { | |
333 | my ($arrow, $k, $v); | |
334 | $arrow = "=> "; | |
335 | while ( ($k,$v) = each(%opctl) ) { | |
336 | print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n"); | |
337 | $arrow = " "; | |
338 | } | |
339 | $arrow = "=> "; | |
340 | while ( ($k,$v) = each(%bopctl) ) { | |
341 | print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n"); | |
342 | $arrow = " "; | |
343 | } | |
344 | } | |
345 | ||
346 | # Process argument list | |
347 | while ( @ARGV > 0 ) { | |
348 | ||
349 | #### Get next argument #### | |
350 | ||
351 | $opt = shift (@ARGV); | |
bb40d378 JV |
352 | print STDERR ("=> option \"", $opt, "\"\n") if $debug; |
353 | ||
354 | #### Determine what we have #### | |
355 | ||
356 | # Double dash is option list terminator. | |
357 | if ( $opt eq $argend ) { | |
358 | # Finish. Push back accumulated arguments and return. | |
359 | unshift (@ARGV, @ret) | |
360 | if $order == $PERMUTE; | |
361 | return ($error == 0); | |
362 | } | |
363 | ||
364 | my $tryopt = $opt; | |
e6d5c530 JV |
365 | my $found; # success status |
366 | my $dsttype; # destination type ('@' or '%') | |
367 | my $incr; # destination increment | |
368 | my $key; # key (if hash type) | |
369 | my $arg; # option argument | |
370 | ||
371 | ($found, $opt, $arg, $dsttype, $incr, $key) = | |
372 | FindOption ($genprefix, $argend, $opt, | |
373 | \%opctl, \%bopctl, \@opctl, \%aliases); | |
bb40d378 | 374 | |
e6d5c530 | 375 | if ( $found ) { |
bb40d378 | 376 | |
e6d5c530 | 377 | # FindOption undefines $opt in case of errors. |
bb40d378 JV |
378 | next unless defined $opt; |
379 | ||
380 | if ( defined $arg ) { | |
381 | $opt = $aliases{$opt} if defined $aliases{$opt}; | |
382 | ||
383 | if ( defined $linkage{$opt} ) { | |
384 | print STDERR ("=> ref(\$L{$opt}) -> ", | |
385 | ref($linkage{$opt}), "\n") if $debug; | |
386 | ||
387 | if ( ref($linkage{$opt}) eq 'SCALAR' ) { | |
e6d5c530 JV |
388 | if ( $incr ) { |
389 | print STDERR ("=> \$\$L{$opt} += \"$arg\"\n") | |
390 | if $debug; | |
391 | if ( defined ${$linkage{$opt}} ) { | |
392 | ${$linkage{$opt}} += $arg; | |
393 | } | |
394 | else { | |
395 | ${$linkage{$opt}} = $arg; | |
396 | } | |
397 | } | |
398 | else { | |
399 | print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") | |
400 | if $debug; | |
401 | ${$linkage{$opt}} = $arg; | |
402 | } | |
bb40d378 JV |
403 | } |
404 | elsif ( ref($linkage{$opt}) eq 'ARRAY' ) { | |
405 | print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") | |
406 | if $debug; | |
407 | push (@{$linkage{$opt}}, $arg); | |
408 | } | |
409 | elsif ( ref($linkage{$opt}) eq 'HASH' ) { | |
410 | print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") | |
411 | if $debug; | |
412 | $linkage{$opt}->{$key} = $arg; | |
413 | } | |
414 | elsif ( ref($linkage{$opt}) eq 'CODE' ) { | |
415 | print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n") | |
416 | if $debug; | |
417 | &{$linkage{$opt}}($opt, $arg); | |
418 | } | |
419 | else { | |
420 | print STDERR ("Invalid REF type \"", ref($linkage{$opt}), | |
421 | "\" in linkage\n"); | |
e6d5c530 | 422 | Croak ("Getopt::Long -- internal error!\n"); |
bb40d378 JV |
423 | } |
424 | } | |
425 | # No entry in linkage means entry in userlinkage. | |
e6d5c530 | 426 | elsif ( $dsttype eq '@' ) { |
bb40d378 JV |
427 | if ( defined $userlinkage->{$opt} ) { |
428 | print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n") | |
429 | if $debug; | |
430 | push (@{$userlinkage->{$opt}}, $arg); | |
431 | } | |
432 | else { | |
433 | print STDERR ("=>\$L{$opt} = [\"$arg\"]\n") | |
434 | if $debug; | |
435 | $userlinkage->{$opt} = [$arg]; | |
436 | } | |
437 | } | |
e6d5c530 | 438 | elsif ( $dsttype eq '%' ) { |
bb40d378 JV |
439 | if ( defined $userlinkage->{$opt} ) { |
440 | print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n") | |
441 | if $debug; | |
442 | $userlinkage->{$opt}->{$key} = $arg; | |
443 | } | |
444 | else { | |
445 | print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n") | |
446 | if $debug; | |
447 | $userlinkage->{$opt} = {$key => $arg}; | |
448 | } | |
449 | } | |
450 | else { | |
e6d5c530 JV |
451 | if ( $incr ) { |
452 | print STDERR ("=> \$L{$opt} += \"$arg\"\n") | |
453 | if $debug; | |
454 | if ( defined $userlinkage->{$opt} ) { | |
455 | $userlinkage->{$opt} += $arg; | |
456 | } | |
457 | else { | |
458 | $userlinkage->{$opt} = $arg; | |
459 | } | |
460 | } | |
461 | else { | |
462 | print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug; | |
463 | $userlinkage->{$opt} = $arg; | |
464 | } | |
bb40d378 JV |
465 | } |
466 | } | |
467 | } | |
468 | ||
469 | # Not an option. Save it if we $PERMUTE and don't have a <>. | |
470 | elsif ( $order == $PERMUTE ) { | |
471 | # Try non-options call-back. | |
472 | my $cb; | |
473 | if ( (defined ($cb = $linkage{'<>'})) ) { | |
474 | &$cb ($tryopt); | |
475 | } | |
476 | else { | |
477 | print STDERR ("=> saving \"$tryopt\" ", | |
478 | "(not an option, may permute)\n") if $debug; | |
479 | push (@ret, $tryopt); | |
480 | } | |
481 | next; | |
482 | } | |
483 | ||
484 | # ...otherwise, terminate. | |
485 | else { | |
486 | # Push this one back and exit. | |
487 | unshift (@ARGV, $tryopt); | |
488 | return ($error == 0); | |
489 | } | |
490 | ||
491 | } | |
492 | ||
493 | # Finish. | |
494 | if ( $order == $PERMUTE ) { | |
495 | # Push back accumulated arguments | |
496 | print STDERR ("=> restoring \"", join('" "', @ret), "\"\n") | |
497 | if $debug && @ret > 0; | |
498 | unshift (@ARGV, @ret) if @ret > 0; | |
499 | } | |
500 | ||
501 | return ($error == 0); | |
502 | } | |
503 | ||
e6d5c530 JV |
504 | # Option lookup. |
505 | sub FindOption ($$$$$$$) { | |
bb40d378 | 506 | |
e6d5c530 JV |
507 | # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay, |
508 | # returns (0) otherwise. | |
bb40d378 | 509 | |
e6d5c530 JV |
510 | my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_; |
511 | my $key; # hash key for a hash option | |
512 | my $arg; | |
bb40d378 | 513 | |
e6d5c530 | 514 | print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug; |
bb40d378 | 515 | |
e6d5c530 | 516 | return (0) unless $opt =~ /^$prefix(.*)$/s; |
bb40d378 | 517 | |
3a0431da | 518 | $opt = $+; |
bb40d378 JV |
519 | my ($starter) = $1; |
520 | ||
521 | print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug; | |
522 | ||
523 | my $optarg = undef; # value supplied with --opt=value | |
524 | my $rest = undef; # remainder from unbundling | |
525 | ||
526 | # If it is a long option, it may include the value. | |
527 | if (($starter eq "--" || ($getopt_compat && !$bundling)) | |
3a0431da | 528 | && $opt =~ /^([^=]+)=(.*)$/s ) { |
bb40d378 JV |
529 | $opt = $1; |
530 | $optarg = $2; | |
531 | print STDERR ("=> option \"", $opt, | |
532 | "\", optarg = \"$optarg\"\n") if $debug; | |
533 | } | |
534 | ||
535 | #### Look it up ### | |
536 | ||
537 | my $tryopt = $opt; # option to try | |
e6d5c530 | 538 | my $optbl = $opctl; # table to look it up (long names) |
bb40d378 | 539 | my $type; |
e6d5c530 JV |
540 | my $dsttype = ''; |
541 | my $incr = 0; | |
bb40d378 JV |
542 | |
543 | if ( $bundling && $starter eq '-' ) { | |
544 | # Unbundle single letter option. | |
545 | $rest = substr ($tryopt, 1); | |
546 | $tryopt = substr ($tryopt, 0, 1); | |
547 | $tryopt = lc ($tryopt) if $ignorecase > 1; | |
548 | print STDERR ("=> $starter$tryopt unbundled from ", | |
549 | "$starter$tryopt$rest\n") if $debug; | |
550 | $rest = undef unless $rest ne ''; | |
e6d5c530 | 551 | $optbl = $bopctl; # look it up in the short names table |
bb40d378 JV |
552 | |
553 | # If bundling == 2, long options can override bundles. | |
554 | if ( $bundling == 2 and | |
f9a400e4 | 555 | defined ($rest) and |
e6d5c530 | 556 | defined ($type = $opctl->{$tryopt.$rest}) ) { |
bb40d378 JV |
557 | print STDERR ("=> $starter$tryopt rebundled to ", |
558 | "$starter$tryopt$rest\n") if $debug; | |
559 | $tryopt .= $rest; | |
560 | undef $rest; | |
561 | } | |
562 | } | |
563 | ||
564 | # Try auto-abbreviation. | |
565 | elsif ( $autoabbrev ) { | |
566 | # Downcase if allowed. | |
567 | $tryopt = $opt = lc ($opt) if $ignorecase; | |
568 | # Turn option name into pattern. | |
569 | my $pat = quotemeta ($opt); | |
570 | # Look up in option names. | |
e6d5c530 | 571 | my @hits = grep (/^$pat/, @{$names}); |
bb40d378 | 572 | print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ", |
e6d5c530 | 573 | "out of ", scalar(@{$names}), "\n") if $debug; |
bb40d378 JV |
574 | |
575 | # Check for ambiguous results. | |
576 | unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { | |
577 | # See if all matches are for the same option. | |
578 | my %hit; | |
579 | foreach ( @hits ) { | |
e6d5c530 | 580 | $_ = $aliases->{$_} if defined $aliases->{$_}; |
bb40d378 JV |
581 | $hit{$_} = 1; |
582 | } | |
583 | # Now see if it really is ambiguous. | |
584 | unless ( keys(%hit) == 1 ) { | |
e6d5c530 | 585 | return (0) if $passthrough; |
bb40d378 JV |
586 | warn ("Option ", $opt, " is ambiguous (", |
587 | join(", ", @hits), ")\n"); | |
588 | $error++; | |
589 | undef $opt; | |
e6d5c530 | 590 | return (1, $opt,$arg,$dsttype,$incr,$key); |
bb40d378 JV |
591 | } |
592 | @hits = keys(%hit); | |
593 | } | |
594 | ||
595 | # Complete the option name, if appropriate. | |
596 | if ( @hits == 1 && $hits[0] ne $opt ) { | |
597 | $tryopt = $hits[0]; | |
598 | $tryopt = lc ($tryopt) if $ignorecase; | |
599 | print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") | |
600 | if $debug; | |
601 | } | |
602 | } | |
603 | ||
604 | # Map to all lowercase if ignoring case. | |
605 | elsif ( $ignorecase ) { | |
606 | $tryopt = lc ($opt); | |
607 | } | |
608 | ||
609 | # Check validity by fetching the info. | |
610 | $type = $optbl->{$tryopt} unless defined $type; | |
611 | unless ( defined $type ) { | |
e6d5c530 | 612 | return (0) if $passthrough; |
bb40d378 JV |
613 | warn ("Unknown option: ", $opt, "\n"); |
614 | $error++; | |
e6d5c530 | 615 | return (1, $opt,$arg,$dsttype,$incr,$key); |
bb40d378 JV |
616 | } |
617 | # Apparently valid. | |
618 | $opt = $tryopt; | |
619 | print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug; | |
620 | ||
621 | #### Determine argument status #### | |
622 | ||
623 | # If it is an option w/o argument, we're almost finished with it. | |
e6d5c530 | 624 | if ( $type eq '' || $type eq '!' || $type eq '+' ) { |
bb40d378 | 625 | if ( defined $optarg ) { |
e6d5c530 | 626 | return (0) if $passthrough; |
bb40d378 JV |
627 | warn ("Option ", $opt, " does not take an argument\n"); |
628 | $error++; | |
629 | undef $opt; | |
630 | } | |
e6d5c530 | 631 | elsif ( $type eq '' || $type eq '+' ) { |
bb40d378 | 632 | $arg = 1; # supply explicit value |
e6d5c530 | 633 | $incr = $type eq '+'; |
bb40d378 JV |
634 | } |
635 | else { | |
636 | substr ($opt, 0, 2) = ''; # strip NO prefix | |
637 | $arg = 0; # supply explicit value | |
638 | } | |
639 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
e6d5c530 | 640 | return (1, $opt,$arg,$dsttype,$incr,$key); |
bb40d378 JV |
641 | } |
642 | ||
643 | # Get mandatory status and type info. | |
644 | my $mand; | |
e6d5c530 | 645 | ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/; |
bb40d378 JV |
646 | |
647 | # Check if there is an option argument available. | |
648 | if ( defined $optarg ? ($optarg eq '') | |
649 | : !(defined $rest || @ARGV > 0) ) { | |
650 | # Complain if this option needs an argument. | |
651 | if ( $mand eq "=" ) { | |
e6d5c530 | 652 | return (0) if $passthrough; |
bb40d378 JV |
653 | warn ("Option ", $opt, " requires an argument\n"); |
654 | $error++; | |
655 | undef $opt; | |
656 | } | |
657 | if ( $mand eq ":" ) { | |
658 | $arg = $type eq "s" ? '' : 0; | |
659 | } | |
e6d5c530 | 660 | return (1, $opt,$arg,$dsttype,$incr,$key); |
bb40d378 JV |
661 | } |
662 | ||
663 | # Get (possibly optional) argument. | |
664 | $arg = (defined $rest ? $rest | |
665 | : (defined $optarg ? $optarg : shift (@ARGV))); | |
666 | ||
667 | # Get key if this is a "name=value" pair for a hash option. | |
668 | $key = undef; | |
e6d5c530 | 669 | if ($dsttype eq '%' && defined $arg) { |
3a0431da | 670 | ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1); |
bb40d378 JV |
671 | } |
672 | ||
673 | #### Check if the argument is valid for this option #### | |
674 | ||
675 | if ( $type eq "s" ) { # string | |
676 | # A mandatory string takes anything. | |
e6d5c530 | 677 | return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "="; |
bb40d378 JV |
678 | |
679 | # An optional string takes almost anything. | |
e6d5c530 JV |
680 | return (1, $opt,$arg,$dsttype,$incr,$key) |
681 | if defined $optarg || defined $rest; | |
682 | return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ?? | |
bb40d378 JV |
683 | |
684 | # Check for option or option list terminator. | |
685 | if ($arg eq $argend || | |
e6d5c530 | 686 | $arg =~ /^$prefix.+/) { |
bb40d378 JV |
687 | # Push back. |
688 | unshift (@ARGV, $arg); | |
689 | # Supply empty value. | |
690 | $arg = ''; | |
691 | } | |
692 | } | |
693 | ||
694 | elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer | |
3a0431da | 695 | if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) { |
bb40d378 JV |
696 | $arg = $1; |
697 | $rest = $2; | |
698 | unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; | |
699 | } | |
700 | elsif ( $arg !~ /^-?[0-9]+$/ ) { | |
701 | if ( defined $optarg || $mand eq "=" ) { | |
702 | if ( $passthrough ) { | |
703 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg) | |
704 | unless defined $optarg; | |
e6d5c530 | 705 | return (0); |
bb40d378 JV |
706 | } |
707 | warn ("Value \"", $arg, "\" invalid for option ", | |
708 | $opt, " (number expected)\n"); | |
709 | $error++; | |
710 | undef $opt; | |
711 | # Push back. | |
712 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
713 | } | |
714 | else { | |
715 | # Push back. | |
716 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
717 | # Supply default value. | |
718 | $arg = 0; | |
719 | } | |
720 | } | |
721 | } | |
722 | ||
723 | elsif ( $type eq "f" ) { # real number, int is also ok | |
724 | # We require at least one digit before a point or 'e', | |
725 | # and at least one digit following the point and 'e'. | |
726 | # [-]NN[.NN][eNN] | |
727 | if ( $bundling && defined $rest && | |
3a0431da | 728 | $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) { |
bb40d378 | 729 | $arg = $1; |
3a0431da | 730 | $rest = $+; |
bb40d378 JV |
731 | unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; |
732 | } | |
733 | elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) { | |
734 | if ( defined $optarg || $mand eq "=" ) { | |
735 | if ( $passthrough ) { | |
736 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg) | |
737 | unless defined $optarg; | |
e6d5c530 | 738 | return (0); |
bb40d378 JV |
739 | } |
740 | warn ("Value \"", $arg, "\" invalid for option ", | |
741 | $opt, " (real number expected)\n"); | |
742 | $error++; | |
743 | undef $opt; | |
744 | # Push back. | |
745 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
746 | } | |
747 | else { | |
748 | # Push back. | |
749 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
750 | # Supply default value. | |
751 | $arg = 0.0; | |
752 | } | |
753 | } | |
754 | } | |
755 | else { | |
e6d5c530 | 756 | Croak ("GetOpt::Long internal error (Can't happen)\n"); |
bb40d378 | 757 | } |
e6d5c530 JV |
758 | return (1, $opt, $arg, $dsttype, $incr, $key); |
759 | } | |
bb40d378 | 760 | |
e6d5c530 JV |
761 | # Getopt::Long Configuration. |
762 | sub Configure (@) { | |
763 | my (@options) = @_; | |
764 | my $opt; | |
765 | foreach $opt ( @options ) { | |
766 | my $try = lc ($opt); | |
767 | my $action = 1; | |
768 | if ( $try =~ /^no_?(.*)$/s ) { | |
769 | $action = 0; | |
770 | $try = $+; | |
771 | } | |
772 | if ( $try eq 'default' or $try eq 'defaults' ) { | |
773 | ConfigDefaults () if $action; | |
774 | } | |
775 | elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) { | |
776 | $autoabbrev = $action; | |
777 | } | |
778 | elsif ( $try eq 'getopt_compat' ) { | |
779 | $getopt_compat = $action; | |
780 | } | |
781 | elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { | |
782 | $ignorecase = $action; | |
783 | } | |
784 | elsif ( $try eq 'ignore_case_always' ) { | |
785 | $ignorecase = $action ? 2 : 0; | |
786 | } | |
787 | elsif ( $try eq 'bundling' ) { | |
788 | $bundling = $action; | |
789 | } | |
790 | elsif ( $try eq 'bundling_override' ) { | |
791 | $bundling = $action ? 2 : 0; | |
792 | } | |
793 | elsif ( $try eq 'require_order' ) { | |
794 | $order = $action ? $REQUIRE_ORDER : $PERMUTE; | |
795 | } | |
796 | elsif ( $try eq 'permute' ) { | |
797 | $order = $action ? $PERMUTE : $REQUIRE_ORDER; | |
798 | } | |
799 | elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) { | |
800 | $passthrough = $action; | |
801 | } | |
802 | elsif ( $try =~ /^prefix=(.+)$/ ) { | |
803 | $genprefix = $1; | |
804 | # Turn into regexp. Needs to be parenthesized! | |
805 | $genprefix = "(" . quotemeta($genprefix) . ")"; | |
806 | eval { '' =~ /$genprefix/; }; | |
807 | Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@; | |
808 | } | |
809 | elsif ( $try =~ /^prefix_pattern=(.+)$/ ) { | |
810 | $genprefix = $1; | |
811 | # Parenthesize if needed. | |
812 | $genprefix = "(" . $genprefix . ")" | |
813 | unless $genprefix =~ /^\(.*\)$/; | |
814 | eval { '' =~ /$genprefix/; }; | |
815 | Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@; | |
816 | } | |
817 | elsif ( $try eq 'debug' ) { | |
818 | $debug = $action; | |
819 | } | |
820 | else { | |
821 | Croak ("Getopt::Long: unknown config parameter \"$opt\"") | |
822 | } | |
bb40d378 | 823 | } |
e6d5c530 | 824 | } |
bb40d378 | 825 | |
e6d5c530 JV |
826 | # Deprecated name. |
827 | sub config (@) { | |
828 | Configure (@_); | |
829 | } | |
bb40d378 | 830 | |
e6d5c530 JV |
831 | # To prevent Carp from being loaded unnecessarily. |
832 | sub Croak (@) { | |
833 | require 'Carp.pm'; | |
834 | $Carp::CarpLevel = 1; | |
835 | Carp::croak(@_); | |
836 | }; | |
bb40d378 | 837 | |
e6d5c530 | 838 | ################ Documentation ################ |
bb40d378 JV |
839 | |
840 | =head1 NAME | |
841 | ||
842 | GetOptions - extended processing of command line options | |
843 | ||
844 | =head1 SYNOPSIS | |
845 | ||
846 | use Getopt::Long; | |
847 | $result = GetOptions (...option-descriptions...); | |
848 | ||
849 | =head1 DESCRIPTION | |
850 | ||
851 | The Getopt::Long module implements an extended getopt function called | |
852 | GetOptions(). This function adheres to the POSIX syntax for command | |
853 | line options, with GNU extensions. In general, this means that options | |
854 | have long names instead of single letters, and are introduced with a | |
855 | double dash "--". Support for bundling of command line options, as was | |
856 | the case with the more traditional single-letter approach, is provided | |
857 | but not enabled by default. For example, the UNIX "ps" command can be | |
858 | given the command line "option" | |
859 | ||
860 | -vax | |
861 | ||
862 | which means the combination of B<-v>, B<-a> and B<-x>. With the new | |
863 | syntax B<--vax> would be a single option, probably indicating a | |
864 | computer architecture. | |
865 | ||
866 | Command line options can be used to set values. These values can be | |
867 | specified in one of two ways: | |
868 | ||
869 | --size 24 | |
870 | --size=24 | |
871 | ||
872 | GetOptions is called with a list of option-descriptions, each of which | |
873 | consists of two elements: the option specifier and the option linkage. | |
874 | The option specifier defines the name of the option and, optionally, | |
875 | the value it can take. The option linkage is usually a reference to a | |
876 | variable that will be set when the option is used. For example, the | |
877 | following call to GetOptions: | |
878 | ||
879 | GetOptions("size=i" => \$offset); | |
880 | ||
881 | will accept a command line option "size" that must have an integer | |
882 | value. With a command line of "--size 24" this will cause the variable | |
883 | $offset to get the value 24. | |
884 | ||
885 | Alternatively, the first argument to GetOptions may be a reference to | |
886 | a HASH describing the linkage for the options, or an object whose | |
887 | class is based on a HASH. The following call is equivalent to the | |
888 | example above: | |
889 | ||
890 | %optctl = ("size" => \$offset); | |
891 | GetOptions(\%optctl, "size=i"); | |
892 | ||
893 | Linkage may be specified using either of the above methods, or both. | |
894 | Linkage specified in the argument list takes precedence over the | |
895 | linkage specified in the HASH. | |
896 | ||
897 | The command line options are taken from array @ARGV. Upon completion | |
898 | of GetOptions, @ARGV will contain the rest (i.e. the non-options) of | |
899 | the command line. | |
900 | ||
901 | Each option specifier designates the name of the option, optionally | |
902 | followed by an argument specifier. | |
903 | ||
904 | Options that do not take arguments will have no argument specifier. | |
905 | The option variable will be set to 1 if the option is used. | |
906 | ||
907 | For the other options, the values for argument specifiers are: | |
908 | ||
909 | =over 8 | |
910 | ||
911 | =item ! | |
912 | ||
913 | Option does not take an argument and may be negated, i.e. prefixed by | |
914 | "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo> | |
915 | (with value 0). | |
916 | The option variable will be set to 1, or 0 if negated. | |
917 | ||
e6d5c530 JV |
918 | =item + |
919 | ||
920 | Option does not take an argument and will be incremented by 1 every | |
921 | time it appears on the command line. E.g. "more+", when used with | |
922 | B<--more --more --more>, will set the option variable to 3 (provided | |
923 | it was 0 or undefined at first). | |
924 | ||
925 | The B<+> specifier is ignored if the option destination is not a SCALAR. | |
926 | ||
bb40d378 JV |
927 | =item =s |
928 | ||
929 | Option takes a mandatory string argument. | |
930 | This string will be assigned to the option variable. | |
931 | Note that even if the string argument starts with B<-> or B<-->, it | |
932 | will not be considered an option on itself. | |
933 | ||
934 | =item :s | |
935 | ||
936 | Option takes an optional string argument. | |
937 | This string will be assigned to the option variable. | |
938 | If omitted, it will be assigned "" (an empty string). | |
939 | If the string argument starts with B<-> or B<-->, it | |
940 | will be considered an option on itself. | |
941 | ||
942 | =item =i | |
943 | ||
944 | Option takes a mandatory integer argument. | |
945 | This value will be assigned to the option variable. | |
946 | Note that the value may start with B<-> to indicate a negative | |
947 | value. | |
948 | ||
949 | =item :i | |
950 | ||
951 | Option takes an optional integer argument. | |
952 | This value will be assigned to the option variable. | |
953 | If omitted, the value 0 will be assigned. | |
954 | Note that the value may start with B<-> to indicate a negative | |
955 | value. | |
956 | ||
957 | =item =f | |
958 | ||
959 | Option takes a mandatory real number argument. | |
404cbe93 | 960 | This value will be assigned to the option variable. |
961 | Note that the value may start with B<-> to indicate a negative | |
962 | value. | |
963 | ||
964 | =item :f | |
965 | ||
966 | Option takes an optional real number argument. | |
967 | This value will be assigned to the option variable. | |
968 | If omitted, the value 0 will be assigned. | |
969 | ||
970 | =back | |
971 | ||
972 | A lone dash B<-> is considered an option, the corresponding option | |
973 | name is the empty string. | |
974 | ||
975 | A double dash on itself B<--> signals end of the options list. | |
976 | ||
977 | =head2 Linkage specification | |
978 | ||
979 | The linkage specifier is optional. If no linkage is explicitly | |
980 | specified but a ref HASH is passed, GetOptions will place the value in | |
981 | the HASH. For example: | |
982 | ||
983 | %optctl = (); | |
02a7d5cb | 984 | GetOptions (\%optctl, "size=i"); |
404cbe93 | 985 | |
986 | will perform the equivalent of the assignment | |
987 | ||
988 | $optctl{"size"} = 24; | |
989 | ||
990 | For array options, a reference to an array is used, e.g.: | |
991 | ||
992 | %optctl = (); | |
02a7d5cb | 993 | GetOptions (\%optctl, "sizes=i@"); |
404cbe93 | 994 | |
995 | with command line "-sizes 24 -sizes 48" will perform the equivalent of | |
996 | the assignment | |
997 | ||
998 | $optctl{"sizes"} = [24, 48]; | |
999 | ||
381319f7 | 1000 | For hash options (an option whose argument looks like "name=value"), |
1001 | a reference to a hash is used, e.g.: | |
1002 | ||
1003 | %optctl = (); | |
02a7d5cb | 1004 | GetOptions (\%optctl, "define=s%"); |
381319f7 | 1005 | |
1006 | with command line "--define foo=hello --define bar=world" will perform the | |
1007 | equivalent of the assignment | |
1008 | ||
1009 | $optctl{"define"} = {foo=>'hello', bar=>'world') | |
1010 | ||
404cbe93 | 1011 | If no linkage is explicitly specified and no ref HASH is passed, |
1012 | GetOptions will put the value in a global variable named after the | |
1013 | option, prefixed by "opt_". To yield a usable Perl variable, | |
1014 | characters that are not part of the syntax for variables are | |
1015 | translated to underscores. For example, "--fpp-struct-return" will set | |
1016 | the variable $opt_fpp_struct_return. Note that this variable resides | |
1017 | in the namespace of the calling program, not necessarily B<main>. | |
1018 | For example: | |
1019 | ||
02a7d5cb | 1020 | GetOptions ("size=i", "sizes=i@"); |
404cbe93 | 1021 | |
1022 | with command line "-size 10 -sizes 24 -sizes 48" will perform the | |
1023 | equivalent of the assignments | |
1024 | ||
1025 | $opt_size = 10; | |
1026 | @opt_sizes = (24, 48); | |
1027 | ||
1028 | A lone dash B<-> is considered an option, the corresponding Perl | |
1029 | identifier is $opt_ . | |
1030 | ||
1031 | The linkage specifier can be a reference to a scalar, a reference to | |
381319f7 | 1032 | an array, a reference to a hash or a reference to a subroutine. |
404cbe93 | 1033 | |
535b5725 TP |
1034 | Note that, if your code is running under the recommended C<use strict |
1035 | 'vars'> pragma, it may be helpful to declare these package variables | |
1036 | via C<use vars> perhaps something like this: | |
1037 | ||
e6d5c530 | 1038 | use vars qw/ $opt_size @opt_sizes $opt_bar /; |
535b5725 | 1039 | |
404cbe93 | 1040 | If a REF SCALAR is supplied, the new value is stored in the referenced |
1041 | variable. If the option occurs more than once, the previous value is | |
1042 | overwritten. | |
1043 | ||
1044 | If a REF ARRAY is supplied, the new value is appended (pushed) to the | |
1045 | referenced array. | |
1046 | ||
381319f7 | 1047 | If a REF HASH is supplied, the option value should look like "key" or |
1048 | "key=value" (if the "=value" is omitted then a value of 1 is implied). | |
1049 | In this case, the element of the referenced hash with the key "key" | |
1050 | is assigned "value". | |
1051 | ||
404cbe93 | 1052 | If a REF CODE is supplied, the referenced subroutine is called with |
1053 | two arguments: the option name and the option value. | |
1054 | The option name is always the true name, not an abbreviation or alias. | |
f06db76b | 1055 | |
404cbe93 | 1056 | =head2 Aliases and abbreviations |
f06db76b AD |
1057 | |
1058 | The option name may actually be a list of option names, separated by | |
404cbe93 | 1059 | "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name |
5f05dabc | 1060 | of this option. If no linkage is specified, options "foo", "bar" and |
bb40d378 JV |
1061 | "blech" all will set $opt_foo. For convenience, the single character |
1062 | "?" is allowed as an alias, e.g. "help|?". | |
f06db76b AD |
1063 | |
1064 | Option names may be abbreviated to uniqueness, depending on | |
a11f5414 | 1065 | configuration option B<auto_abbrev>. |
f06db76b | 1066 | |
404cbe93 | 1067 | =head2 Non-option call-back routine |
f06db76b | 1068 | |
5f05dabc | 1069 | A special option specifier, E<lt>E<gt>, can be used to designate a subroutine |
404cbe93 | 1070 | to handle non-option arguments. GetOptions will immediately call this |
1071 | subroutine for every non-option it encounters in the options list. | |
1072 | This subroutine gets the name of the non-option passed. | |
a11f5414 JV |
1073 | This feature requires configuration option B<permute>, see section |
1074 | CONFIGURATION OPTIONS. | |
1075 | ||
404cbe93 | 1076 | See also the examples. |
f06db76b | 1077 | |
404cbe93 | 1078 | =head2 Option starters |
f06db76b | 1079 | |
404cbe93 | 1080 | On the command line, options can start with B<-> (traditional), B<--> |
1081 | (POSIX) and B<+> (GNU, now being phased out). The latter is not | |
1082 | allowed if the environment variable B<POSIXLY_CORRECT> has been | |
1083 | defined. | |
f06db76b AD |
1084 | |
1085 | Options that start with "--" may have an argument appended, separated | |
1086 | with an "=", e.g. "--foo=bar". | |
1087 | ||
bb40d378 JV |
1088 | =head2 Return values and Errors |
1089 | ||
1090 | Configuration errors and errors in the option definitions are | |
1091 | signalled using C<die()> and will terminate the calling | |
1092 | program unless the call to C<Getopt::Long::GetOptions()> was embedded | |
1093 | in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>. | |
1094 | ||
1095 | A return value of 1 (true) indicates success. | |
f06db76b | 1096 | |
bb40d378 JV |
1097 | A return status of 0 (false) indicates that the function detected one |
1098 | or more errors during option parsing. These errors are signalled using | |
1099 | C<warn()> and can be trapped with C<$SIG{__WARN__}>. | |
1100 | ||
1101 | Errors that can't happen are signalled using C<Carp::croak()>. | |
f06db76b | 1102 | |
404cbe93 | 1103 | =head1 COMPATIBILITY |
1104 | ||
1105 | Getopt::Long::GetOptions() is the successor of | |
1106 | B<newgetopt.pl> that came with Perl 4. It is fully upward compatible. | |
1107 | In fact, the Perl 5 version of newgetopt.pl is just a wrapper around | |
1108 | the module. | |
1109 | ||
1110 | If an "@" sign is appended to the argument specifier, the option is | |
381319f7 | 1111 | treated as an array. Value(s) are not set, but pushed into array |
1112 | @opt_name. If explicit linkage is supplied, this must be a reference | |
1113 | to an ARRAY. | |
1114 | ||
1115 | If an "%" sign is appended to the argument specifier, the option is | |
1116 | treated as a hash. Value(s) of the form "name=value" are set by | |
1117 | setting the element of the hash %opt_name with key "name" to "value" | |
1118 | (if the "=value" portion is omitted it defaults to 1). If explicit | |
1119 | linkage is supplied, this must be a reference to a HASH. | |
404cbe93 | 1120 | |
a11f5414 JV |
1121 | If configuration option B<getopt_compat> is set (see section |
1122 | CONFIGURATION OPTIONS), options that start with "+" or "-" may also | |
1123 | include their arguments, e.g. "+foo=bar". This is for compatiblity | |
1124 | with older implementations of the GNU "getopt" routine. | |
404cbe93 | 1125 | |
1a505819 GS |
1126 | If the first argument to GetOptions (after the optional linkage |
1127 | specification) is a string consisting of only non-alphanumeric | |
1128 | characters, it is taken to specify the option starter characters. | |
1129 | Everything starting with one of these characters from the starter will | |
1130 | be considered an option. GetOptions will not interpret a leading | |
1131 | "<>" as option starters if the next argument is a reference. To | |
1132 | force "<" and ">" as option starters, use "><". Confusing? Well, | |
1133 | B<using a starter argument is strongly deprecated.> | |
a11f5414 | 1134 | |
bb40d378 JV |
1135 | For convenience, option specifiers may have a leading B<-> or B<-->, |
1136 | so it is possible to write: | |
a11f5414 | 1137 | |
bb40d378 | 1138 | GetOptions qw(-foo=s --bar=i --ar=s); |
a11f5414 | 1139 | |
bb40d378 | 1140 | =head1 EXAMPLES |
a11f5414 | 1141 | |
bb40d378 JV |
1142 | If the option specifier is "one:i" (i.e. takes an optional integer |
1143 | argument), then the following situations are handled: | |
381319f7 | 1144 | |
bb40d378 JV |
1145 | -one -two -> $opt_one = '', -two is next option |
1146 | -one -2 -> $opt_one = -2 | |
f06db76b | 1147 | |
bb40d378 | 1148 | Also, assume specifiers "foo=s" and "bar:s" : |
f06db76b | 1149 | |
bb40d378 JV |
1150 | -bar -xxx -> $opt_bar = '', '-xxx' is next option |
1151 | -foo -bar -> $opt_foo = '-bar' | |
1152 | -foo -- -> $opt_foo = '--' | |
f06db76b | 1153 | |
bb40d378 | 1154 | In GNU or POSIX format, option names and values can be combined: |
a0d0e21e | 1155 | |
bb40d378 JV |
1156 | +foo=blech -> $opt_foo = 'blech' |
1157 | --bar= -> $opt_bar = '' | |
1158 | --bar=-- -> $opt_bar = '--' | |
a0d0e21e | 1159 | |
bb40d378 | 1160 | Example of using variable references: |
404cbe93 | 1161 | |
bb40d378 | 1162 | $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar); |
404cbe93 | 1163 | |
bb40d378 JV |
1164 | With command line options "-foo blech -bar 24 -ar xx -ar yy" |
1165 | this will result in: | |
a0d0e21e | 1166 | |
bb40d378 JV |
1167 | $foo = 'blech' |
1168 | $opt_bar = 24 | |
1169 | @ar = ('xx','yy') | |
a11f5414 | 1170 | |
bb40d378 | 1171 | Example of using the E<lt>E<gt> option specifier: |
a0d0e21e | 1172 | |
bb40d378 JV |
1173 | @ARGV = qw(-foo 1 bar -foo 2 blech); |
1174 | GetOptions("foo=i", \$myfoo, "<>", \&mysub); | |
a0d0e21e | 1175 | |
bb40d378 | 1176 | Results: |
a0d0e21e | 1177 | |
bb40d378 JV |
1178 | mysub("bar") will be called (with $myfoo being 1) |
1179 | mysub("blech") will be called (with $myfoo being 2) | |
a0d0e21e | 1180 | |
bb40d378 | 1181 | Compare this with: |
a0d0e21e | 1182 | |
bb40d378 JV |
1183 | @ARGV = qw(-foo 1 bar -foo 2 blech); |
1184 | GetOptions("foo=i", \$myfoo); | |
a11f5414 | 1185 | |
bb40d378 | 1186 | This will leave the non-options in @ARGV: |
404cbe93 | 1187 | |
bb40d378 JV |
1188 | $myfoo -> 2 |
1189 | @ARGV -> qw(bar blech) | |
381319f7 | 1190 | |
bb40d378 | 1191 | =head1 CONFIGURATION OPTIONS |
a0d0e21e | 1192 | |
bb40d378 | 1193 | B<GetOptions> can be configured by calling subroutine |
e6d5c530 | 1194 | B<Getopt::Long::Configure>. This subroutine takes a list of quoted |
bb40d378 JV |
1195 | strings, each specifying a configuration option to be set, e.g. |
1196 | B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g. | |
1197 | B<no_ignore_case>. Case does not matter. Multiple calls to B<config> | |
1198 | are possible. | |
a0d0e21e | 1199 | |
bb40d378 JV |
1200 | Previous versions of Getopt::Long used variables for the purpose of |
1201 | configuring. Although manipulating these variables still work, it | |
1202 | is strongly encouraged to use the new B<config> routine. Besides, it | |
1203 | is much easier. | |
404cbe93 | 1204 | |
bb40d378 | 1205 | The following options are available: |
404cbe93 | 1206 | |
bb40d378 | 1207 | =over 12 |
a0d0e21e | 1208 | |
bb40d378 | 1209 | =item default |
a0d0e21e | 1210 | |
bb40d378 JV |
1211 | This option causes all configuration options to be reset to their |
1212 | default values. | |
404cbe93 | 1213 | |
bb40d378 | 1214 | =item auto_abbrev |
404cbe93 | 1215 | |
bb40d378 JV |
1216 | Allow option names to be abbreviated to uniqueness. |
1217 | Default is set unless environment variable | |
1218 | POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset. | |
404cbe93 | 1219 | |
bb40d378 | 1220 | =item getopt_compat |
a0d0e21e | 1221 | |
bb40d378 JV |
1222 | Allow '+' to start options. |
1223 | Default is set unless environment variable | |
1224 | POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset. | |
88e49c4e | 1225 | |
bb40d378 | 1226 | =item require_order |
404cbe93 | 1227 | |
bb40d378 JV |
1228 | Whether non-options are allowed to be mixed with |
1229 | options. | |
1230 | Default is set unless environment variable | |
1231 | POSIXLY_CORRECT has been set, in which case b<require_order> is reset. | |
404cbe93 | 1232 | |
bb40d378 | 1233 | See also B<permute>, which is the opposite of B<require_order>. |
a0d0e21e | 1234 | |
bb40d378 | 1235 | =item permute |
404cbe93 | 1236 | |
bb40d378 JV |
1237 | Whether non-options are allowed to be mixed with |
1238 | options. | |
1239 | Default is set unless environment variable | |
1240 | POSIXLY_CORRECT has been set, in which case B<permute> is reset. | |
1241 | Note that B<permute> is the opposite of B<require_order>. | |
a0d0e21e | 1242 | |
bb40d378 | 1243 | If B<permute> is set, this means that |
a0d0e21e | 1244 | |
bb40d378 | 1245 | -foo arg1 -bar arg2 arg3 |
a0d0e21e | 1246 | |
bb40d378 | 1247 | is equivalent to |
a0d0e21e | 1248 | |
bb40d378 | 1249 | -foo -bar arg1 arg2 arg3 |
a0d0e21e | 1250 | |
bb40d378 JV |
1251 | If a non-option call-back routine is specified, @ARGV will always be |
1252 | empty upon succesful return of GetOptions since all options have been | |
1253 | processed, except when B<--> is used: | |
a0d0e21e | 1254 | |
bb40d378 | 1255 | -foo arg1 -bar arg2 -- arg3 |
404cbe93 | 1256 | |
bb40d378 JV |
1257 | will call the call-back routine for arg1 and arg2, and terminate |
1258 | leaving arg2 in @ARGV. | |
381319f7 | 1259 | |
bb40d378 JV |
1260 | If B<require_order> is set, options processing |
1261 | terminates when the first non-option is encountered. | |
a0d0e21e | 1262 | |
bb40d378 | 1263 | -foo arg1 -bar arg2 arg3 |
381319f7 | 1264 | |
bb40d378 | 1265 | is equivalent to |
381319f7 | 1266 | |
bb40d378 | 1267 | -foo -- arg1 -bar arg2 arg3 |
404cbe93 | 1268 | |
bb40d378 | 1269 | =item bundling (default: reset) |
404cbe93 | 1270 | |
bb40d378 JV |
1271 | Setting this variable to a non-zero value will allow single-character |
1272 | options to be bundled. To distinguish bundles from long option names, | |
1273 | long options must be introduced with B<--> and single-character | |
1274 | options (and bundles) with B<->. For example, | |
a0d0e21e | 1275 | |
bb40d378 | 1276 | ps -vax --vax |
381319f7 | 1277 | |
bb40d378 | 1278 | would be equivalent to |
381319f7 | 1279 | |
bb40d378 | 1280 | ps -v -a -x --vax |
381319f7 | 1281 | |
bb40d378 JV |
1282 | provided "vax", "v", "a" and "x" have been defined to be valid |
1283 | options. | |
1284 | ||
1285 | Bundled options can also include a value in the bundle; for strings | |
1286 | this value is the rest of the bundle, but integer and floating values | |
1287 | may be combined in the bundle, e.g. | |
1288 | ||
1289 | scale -h24w80 | |
1290 | ||
1291 | is equivalent to | |
a11f5414 | 1292 | |
bb40d378 | 1293 | scale -h 24 -w 80 |
a11f5414 | 1294 | |
bb40d378 | 1295 | Note: resetting B<bundling> also resets B<bundling_override>. |
a11f5414 | 1296 | |
bb40d378 | 1297 | =item bundling_override (default: reset) |
381319f7 | 1298 | |
bb40d378 JV |
1299 | If B<bundling_override> is set, bundling is enabled as with |
1300 | B<bundling> but now long option names override option bundles. In the | |
1301 | above example, B<-vax> would be interpreted as the option "vax", not | |
1302 | the bundle "v", "a", "x". | |
381319f7 | 1303 | |
bb40d378 | 1304 | Note: resetting B<bundling_override> also resets B<bundling>. |
381319f7 | 1305 | |
bb40d378 JV |
1306 | B<Note:> Using option bundling can easily lead to unexpected results, |
1307 | especially when mixing long options and bundles. Caveat emptor. | |
381319f7 | 1308 | |
bb40d378 | 1309 | =item ignore_case (default: set) |
381319f7 | 1310 | |
bb40d378 | 1311 | If set, case is ignored when matching options. |
381319f7 | 1312 | |
bb40d378 | 1313 | Note: resetting B<ignore_case> also resets B<ignore_case_always>. |
381319f7 | 1314 | |
bb40d378 | 1315 | =item ignore_case_always (default: reset) |
a11f5414 | 1316 | |
bb40d378 JV |
1317 | When bundling is in effect, case is ignored on single-character |
1318 | options also. | |
381319f7 | 1319 | |
bb40d378 | 1320 | Note: resetting B<ignore_case_always> also resets B<ignore_case>. |
381319f7 | 1321 | |
bb40d378 | 1322 | =item pass_through (default: reset) |
a0d0e21e | 1323 | |
bb40d378 JV |
1324 | Unknown options are passed through in @ARGV instead of being flagged |
1325 | as errors. This makes it possible to write wrapper scripts that | |
1326 | process only part of the user supplied options, and passes the | |
1327 | remaining options to some other program. | |
a0d0e21e | 1328 | |
bb40d378 | 1329 | This can be very confusing, especially when B<permute> is also set. |
16c18a90 | 1330 | |
3a0431da JV |
1331 | =item prefix |
1332 | ||
1333 | The string that starts options. See also B<prefix_pattern>. | |
1334 | ||
1335 | =item prefix_pattern | |
1336 | ||
1337 | A Perl pattern that identifies the strings that introduce options. | |
1338 | Default is C<(--|-|\+)> unless environment variable | |
1339 | POSIXLY_CORRECT has been set, in which case it is C<(--|-)>. | |
1340 | ||
bb40d378 | 1341 | =item debug (default: reset) |
a0d0e21e | 1342 | |
bb40d378 | 1343 | Enable copious debugging output. |
a0d0e21e | 1344 | |
bb40d378 | 1345 | =back |
a0d0e21e | 1346 | |
bb40d378 | 1347 | =head1 OTHER USEFUL VARIABLES |
381319f7 | 1348 | |
bb40d378 | 1349 | =over 12 |
a0d0e21e | 1350 | |
bb40d378 | 1351 | =item $Getopt::Long::VERSION |
a0d0e21e | 1352 | |
bb40d378 JV |
1353 | The version number of this Getopt::Long implementation in the format |
1354 | C<major>.C<minor>. This can be used to have Exporter check the | |
1355 | version, e.g. | |
a0d0e21e | 1356 | |
bb40d378 | 1357 | use Getopt::Long 3.00; |
a0d0e21e | 1358 | |
bb40d378 JV |
1359 | You can inspect $Getopt::Long::major_version and |
1360 | $Getopt::Long::minor_version for the individual components. | |
a0d0e21e | 1361 | |
bb40d378 | 1362 | =item $Getopt::Long::error |
a0d0e21e | 1363 | |
bb40d378 JV |
1364 | Internal error flag. May be incremented from a call-back routine to |
1365 | cause options parsing to fail. | |
a0d0e21e | 1366 | |
bb40d378 | 1367 | =back |
a0d0e21e | 1368 | |
bb40d378 | 1369 | =head1 AUTHOR |
a11f5414 | 1370 | |
bb40d378 | 1371 | Johan Vromans E<lt>jvromans@squirrel.nlE<gt> |
a11f5414 | 1372 | |
bb40d378 | 1373 | =head1 COPYRIGHT AND DISCLAIMER |
a11f5414 | 1374 | |
f9a400e4 | 1375 | This program is Copyright 1990,1999 by Johan Vromans. |
bb40d378 | 1376 | This program is free software; you can redistribute it and/or |
1a505819 GS |
1377 | modify it under the terms of the Perl Artistic License or the |
1378 | GNU General Public License as published by the Free Software | |
1379 | Foundation; either version 2 of the License, or (at your option) any | |
1380 | later version. | |
a11f5414 | 1381 | |
bb40d378 JV |
1382 | This program is distributed in the hope that it will be useful, |
1383 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
1384 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
1385 | GNU General Public License for more details. | |
a0d0e21e | 1386 | |
bb40d378 | 1387 | If you do not have a copy of the GNU General Public License write to |
f9a400e4 JH |
1388 | the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, |
1389 | MA 02139, USA. | |
a0d0e21e | 1390 | |
bb40d378 | 1391 | =cut |