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