Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # GetOpt::Long.pm -- Universal options parsing |
2 | ||
3 | package Getopt::Long; | |
4 | ||
5 | # RCS Status : $Id: GetoptLong.pm,v 2.58 2002-06-20 09:32:09+02 jv Exp $ | |
6 | # Author : Johan Vromans | |
7 | # Created On : Tue Sep 11 15:00:12 1990 | |
8 | # Last Modified By: Johan Vromans | |
9 | # Last Modified On: Thu Jun 20 07:48:05 2002 | |
10 | # Update Count : 1083 | |
11 | # Status : Released | |
12 | ||
13 | ################ Copyright ################ | |
14 | ||
15 | # This program is Copyright 1990,2002 by Johan Vromans. | |
16 | # This program is free software; you can redistribute it and/or | |
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 | # | |
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 | |
28 | # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, | |
29 | # MA 02139, USA. | |
30 | ||
31 | ################ Module Preamble ################ | |
32 | ||
33 | use 5.004; | |
34 | ||
35 | use strict; | |
36 | ||
37 | use vars qw($VERSION); | |
38 | $VERSION = 2.32; | |
39 | # For testing versions only. | |
40 | use vars qw($VERSION_STRING); | |
41 | $VERSION_STRING = "2.32"; | |
42 | ||
43 | use Exporter; | |
44 | ||
45 | use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); | |
46 | @ISA = qw(Exporter); | |
47 | %EXPORT_TAGS = qw(); | |
48 | BEGIN { | |
49 | # Init immediately so their contents can be used in the 'use vars' below. | |
50 | @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); | |
51 | @EXPORT_OK = qw(); | |
52 | } | |
53 | ||
54 | # User visible variables. | |
55 | use vars @EXPORT, @EXPORT_OK; | |
56 | use vars qw($error $debug $major_version $minor_version); | |
57 | # Deprecated visible variables. | |
58 | use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order | |
59 | $passthrough); | |
60 | # Official invisible variables. | |
61 | use vars qw($genprefix $caller $gnu_compat); | |
62 | ||
63 | # Public subroutines. | |
64 | sub Configure (@); | |
65 | sub config (@); # deprecated name | |
66 | sub GetOptions; | |
67 | ||
68 | # Private subroutines. | |
69 | sub ConfigDefaults (); | |
70 | sub ParseOptionSpec ($$); | |
71 | sub OptCtl ($); | |
72 | sub FindOption ($$$$); | |
73 | ||
74 | ################ Local Variables ################ | |
75 | ||
76 | ################ Resident subroutines ################ | |
77 | ||
78 | sub ConfigDefaults () { | |
79 | # Handle POSIX compliancy. | |
80 | if ( defined $ENV{"POSIXLY_CORRECT"} ) { | |
81 | $genprefix = "(--|-)"; | |
82 | $autoabbrev = 0; # no automatic abbrev of options | |
83 | $bundling = 0; # no bundling of single letter switches | |
84 | $getopt_compat = 0; # disallow '+' to start options | |
85 | $order = $REQUIRE_ORDER; | |
86 | } | |
87 | else { | |
88 | $genprefix = "(--|-|\\+)"; | |
89 | $autoabbrev = 1; # automatic abbrev of options | |
90 | $bundling = 0; # bundling off by default | |
91 | $getopt_compat = 1; # allow '+' to start options | |
92 | $order = $PERMUTE; | |
93 | } | |
94 | # Other configurable settings. | |
95 | $debug = 0; # for debugging | |
96 | $error = 0; # error tally | |
97 | $ignorecase = 1; # ignore case when matching options | |
98 | $passthrough = 0; # leave unrecognized options alone | |
99 | $gnu_compat = 0; # require --opt=val if value is optional | |
100 | } | |
101 | ||
102 | # Override import. | |
103 | sub import { | |
104 | my $pkg = shift; # package | |
105 | my @syms = (); # symbols to import | |
106 | my @config = (); # configuration | |
107 | my $dest = \@syms; # symbols first | |
108 | for ( @_ ) { | |
109 | if ( $_ eq ':config' ) { | |
110 | $dest = \@config; # config next | |
111 | next; | |
112 | } | |
113 | push (@$dest, $_); # push | |
114 | } | |
115 | # Hide one level and call super. | |
116 | local $Exporter::ExportLevel = 1; | |
117 | $pkg->SUPER::import(@syms); | |
118 | # And configure. | |
119 | Configure (@config) if @config; | |
120 | } | |
121 | ||
122 | ################ Initialization ################ | |
123 | ||
124 | # Values for $order. See GNU getopt.c for details. | |
125 | ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); | |
126 | # Version major/minor numbers. | |
127 | ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/; | |
128 | ||
129 | ConfigDefaults(); | |
130 | ||
131 | ################ OO Interface ################ | |
132 | ||
133 | package Getopt::Long::Parser; | |
134 | ||
135 | # Store a copy of the default configuration. Since ConfigDefaults has | |
136 | # just been called, what we get from Configure is the default. | |
137 | my $default_config = do { | |
138 | Getopt::Long::Configure () | |
139 | }; | |
140 | ||
141 | sub new { | |
142 | my $that = shift; | |
143 | my $class = ref($that) || $that; | |
144 | my %atts = @_; | |
145 | ||
146 | # Register the callers package. | |
147 | my $self = { caller_pkg => (caller)[0] }; | |
148 | ||
149 | bless ($self, $class); | |
150 | ||
151 | # Process config attributes. | |
152 | if ( defined $atts{config} ) { | |
153 | my $save = Getopt::Long::Configure ($default_config, @{$atts{config}}); | |
154 | $self->{settings} = Getopt::Long::Configure ($save); | |
155 | delete ($atts{config}); | |
156 | } | |
157 | # Else use default config. | |
158 | else { | |
159 | $self->{settings} = $default_config; | |
160 | } | |
161 | ||
162 | if ( %atts ) { # Oops | |
163 | die(__PACKAGE__.": unhandled attributes: ". | |
164 | join(" ", sort(keys(%atts)))."\n"); | |
165 | } | |
166 | ||
167 | $self; | |
168 | } | |
169 | ||
170 | sub configure { | |
171 | my ($self) = shift; | |
172 | ||
173 | # Restore settings, merge new settings in. | |
174 | my $save = Getopt::Long::Configure ($self->{settings}, @_); | |
175 | ||
176 | # Restore orig config and save the new config. | |
177 | $self->{settings} = Getopt::Long::Configure ($save); | |
178 | } | |
179 | ||
180 | sub getoptions { | |
181 | my ($self) = shift; | |
182 | ||
183 | # Restore config settings. | |
184 | my $save = Getopt::Long::Configure ($self->{settings}); | |
185 | ||
186 | # Call main routine. | |
187 | my $ret = 0; | |
188 | $Getopt::Long::caller = $self->{caller_pkg}; | |
189 | ||
190 | eval { | |
191 | # Locally set exception handler to default, otherwise it will | |
192 | # be called implicitly here, and again explicitly when we try | |
193 | # to deliver the messages. | |
194 | local ($SIG{__DIE__}) = '__DEFAULT__'; | |
195 | $ret = Getopt::Long::GetOptions (@_); | |
196 | }; | |
197 | ||
198 | # Restore saved settings. | |
199 | Getopt::Long::Configure ($save); | |
200 | ||
201 | # Handle errors and return value. | |
202 | die ($@) if $@; | |
203 | return $ret; | |
204 | } | |
205 | ||
206 | package Getopt::Long; | |
207 | ||
208 | # Indices in option control info. | |
209 | # Note that ParseOptions uses the fields directly. Search for 'hard-wired'. | |
210 | use constant CTL_TYPE => 0; | |
211 | #use constant CTL_TYPE_FLAG => ''; | |
212 | #use constant CTL_TYPE_NEG => '!'; | |
213 | #use constant CTL_TYPE_INCR => '+'; | |
214 | #use constant CTL_TYPE_INT => 'i'; | |
215 | #use constant CTL_TYPE_INTINC => 'I'; | |
216 | #use constant CTL_TYPE_XINT => 'o'; | |
217 | #use constant CTL_TYPE_FLOAT => 'f'; | |
218 | #use constant CTL_TYPE_STRING => 's'; | |
219 | ||
220 | use constant CTL_CNAME => 1; | |
221 | ||
222 | use constant CTL_MAND => 2; | |
223 | ||
224 | use constant CTL_DEST => 3; | |
225 | use constant CTL_DEST_SCALAR => 0; | |
226 | use constant CTL_DEST_ARRAY => 1; | |
227 | use constant CTL_DEST_HASH => 2; | |
228 | use constant CTL_DEST_CODE => 3; | |
229 | ||
230 | use constant CTL_DEFAULT => 4; | |
231 | ||
232 | # FFU. | |
233 | #use constant CTL_RANGE => ; | |
234 | #use constant CTL_REPEAT => ; | |
235 | ||
236 | sub GetOptions { | |
237 | ||
238 | my @optionlist = @_; # local copy of the option descriptions | |
239 | my $argend = '--'; # option list terminator | |
240 | my %opctl = (); # table of option specs | |
241 | my $pkg = $caller || (caller)[0]; # current context | |
242 | # Needed if linkage is omitted. | |
243 | my @ret = (); # accum for non-options | |
244 | my %linkage; # linkage | |
245 | my $userlinkage; # user supplied HASH | |
246 | my $opt; # current option | |
247 | my $prefix = $genprefix; # current prefix | |
248 | ||
249 | $error = ''; | |
250 | ||
251 | print STDERR ("GetOpt::Long $Getopt::Long::VERSION (", | |
252 | '$Revision: 2.58 $', ") ", | |
253 | "called from package \"$pkg\".", | |
254 | "\n ", | |
255 | "ARGV: (@ARGV)", | |
256 | "\n ", | |
257 | "autoabbrev=$autoabbrev,". | |
258 | "bundling=$bundling,", | |
259 | "getopt_compat=$getopt_compat,", | |
260 | "gnu_compat=$gnu_compat,", | |
261 | "order=$order,", | |
262 | "\n ", | |
263 | "ignorecase=$ignorecase,", | |
264 | "passthrough=$passthrough,", | |
265 | "genprefix=\"$genprefix\".", | |
266 | "\n") | |
267 | if $debug; | |
268 | ||
269 | # Check for ref HASH as first argument. | |
270 | # First argument may be an object. It's OK to use this as long | |
271 | # as it is really a hash underneath. | |
272 | $userlinkage = undef; | |
273 | if ( @optionlist && ref($optionlist[0]) and | |
274 | "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) { | |
275 | $userlinkage = shift (@optionlist); | |
276 | print STDERR ("=> user linkage: $userlinkage\n") if $debug; | |
277 | } | |
278 | ||
279 | # See if the first element of the optionlist contains option | |
280 | # starter characters. | |
281 | # Be careful not to interpret '<>' as option starters. | |
282 | if ( @optionlist && $optionlist[0] =~ /^\W+$/ | |
283 | && !($optionlist[0] eq '<>' | |
284 | && @optionlist > 0 | |
285 | && ref($optionlist[1])) ) { | |
286 | $prefix = shift (@optionlist); | |
287 | # Turn into regexp. Needs to be parenthesized! | |
288 | $prefix =~ s/(\W)/\\$1/g; | |
289 | $prefix = "([" . $prefix . "])"; | |
290 | print STDERR ("=> prefix=\"$prefix\"\n") if $debug; | |
291 | } | |
292 | ||
293 | # Verify correctness of optionlist. | |
294 | %opctl = (); | |
295 | while ( @optionlist ) { | |
296 | my $opt = shift (@optionlist); | |
297 | ||
298 | # Strip leading prefix so people can specify "--foo=i" if they like. | |
299 | $opt = $+ if $opt =~ /^$prefix+(.*)$/s; | |
300 | ||
301 | if ( $opt eq '<>' ) { | |
302 | if ( (defined $userlinkage) | |
303 | && !(@optionlist > 0 && ref($optionlist[0])) | |
304 | && (exists $userlinkage->{$opt}) | |
305 | && ref($userlinkage->{$opt}) ) { | |
306 | unshift (@optionlist, $userlinkage->{$opt}); | |
307 | } | |
308 | unless ( @optionlist > 0 | |
309 | && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { | |
310 | $error .= "Option spec <> requires a reference to a subroutine\n"; | |
311 | # Kill the linkage (to avoid another error). | |
312 | shift (@optionlist) | |
313 | if @optionlist && ref($optionlist[0]); | |
314 | next; | |
315 | } | |
316 | $linkage{'<>'} = shift (@optionlist); | |
317 | next; | |
318 | } | |
319 | ||
320 | # Parse option spec. | |
321 | my ($name, $orig) = ParseOptionSpec ($opt, \%opctl); | |
322 | unless ( defined $name ) { | |
323 | # Failed. $orig contains the error message. Sorry for the abuse. | |
324 | $error .= $orig; | |
325 | # Kill the linkage (to avoid another error). | |
326 | shift (@optionlist) | |
327 | if @optionlist && ref($optionlist[0]); | |
328 | next; | |
329 | } | |
330 | ||
331 | # If no linkage is supplied in the @optionlist, copy it from | |
332 | # the userlinkage if available. | |
333 | if ( defined $userlinkage ) { | |
334 | unless ( @optionlist > 0 && ref($optionlist[0]) ) { | |
335 | if ( exists $userlinkage->{$orig} && | |
336 | ref($userlinkage->{$orig}) ) { | |
337 | print STDERR ("=> found userlinkage for \"$orig\": ", | |
338 | "$userlinkage->{$orig}\n") | |
339 | if $debug; | |
340 | unshift (@optionlist, $userlinkage->{$orig}); | |
341 | } | |
342 | else { | |
343 | # Do nothing. Being undefined will be handled later. | |
344 | next; | |
345 | } | |
346 | } | |
347 | } | |
348 | ||
349 | # Copy the linkage. If omitted, link to global variable. | |
350 | if ( @optionlist > 0 && ref($optionlist[0]) ) { | |
351 | print STDERR ("=> link \"$orig\" to $optionlist[0]\n") | |
352 | if $debug; | |
353 | my $rl = ref($linkage{$orig} = shift (@optionlist)); | |
354 | ||
355 | if ( $rl eq "ARRAY" ) { | |
356 | $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY; | |
357 | } | |
358 | elsif ( $rl eq "HASH" ) { | |
359 | $opctl{$name}[CTL_DEST] = CTL_DEST_HASH; | |
360 | } | |
361 | elsif ( $rl eq "SCALAR" || $rl eq "CODE" ) { | |
362 | # Ok. | |
363 | } | |
364 | else { | |
365 | $error .= "Invalid option linkage for \"$opt\"\n"; | |
366 | } | |
367 | } | |
368 | else { | |
369 | # Link to global $opt_XXX variable. | |
370 | # Make sure a valid perl identifier results. | |
371 | my $ov = $orig; | |
372 | $ov =~ s/\W/_/g; | |
373 | if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) { | |
374 | print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n") | |
375 | if $debug; | |
376 | eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;"); | |
377 | } | |
378 | elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) { | |
379 | print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n") | |
380 | if $debug; | |
381 | eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;"); | |
382 | } | |
383 | else { | |
384 | print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n") | |
385 | if $debug; | |
386 | eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;"); | |
387 | } | |
388 | } | |
389 | } | |
390 | ||
391 | # Bail out if errors found. | |
392 | die ($error) if $error; | |
393 | $error = 0; | |
394 | ||
395 | # Show the options tables if debugging. | |
396 | if ( $debug ) { | |
397 | my ($arrow, $k, $v); | |
398 | $arrow = "=> "; | |
399 | while ( ($k,$v) = each(%opctl) ) { | |
400 | print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n"); | |
401 | $arrow = " "; | |
402 | } | |
403 | } | |
404 | ||
405 | # Process argument list | |
406 | my $goon = 1; | |
407 | while ( $goon && @ARGV > 0 ) { | |
408 | ||
409 | # Get next argument. | |
410 | $opt = shift (@ARGV); | |
411 | print STDERR ("=> arg \"", $opt, "\"\n") if $debug; | |
412 | ||
413 | # Double dash is option list terminator. | |
414 | last if $opt eq $argend; | |
415 | ||
416 | # Look it up. | |
417 | my $tryopt = $opt; | |
418 | my $found; # success status | |
419 | my $key; # key (if hash type) | |
420 | my $arg; # option argument | |
421 | my $ctl; # the opctl entry | |
422 | ||
423 | ($found, $opt, $ctl, $arg, $key) = | |
424 | FindOption ($prefix, $argend, $opt, \%opctl); | |
425 | ||
426 | if ( $found ) { | |
427 | ||
428 | # FindOption undefines $opt in case of errors. | |
429 | next unless defined $opt; | |
430 | ||
431 | if ( defined $arg ) { | |
432 | ||
433 | # Get the canonical name. | |
434 | print STDERR ("=> cname for \"$opt\" is ") if $debug; | |
435 | $opt = $ctl->[CTL_CNAME]; | |
436 | print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug; | |
437 | ||
438 | if ( defined $linkage{$opt} ) { | |
439 | print STDERR ("=> ref(\$L{$opt}) -> ", | |
440 | ref($linkage{$opt}), "\n") if $debug; | |
441 | ||
442 | if ( ref($linkage{$opt}) eq 'SCALAR' ) { | |
443 | if ( $ctl->[CTL_TYPE] eq '+' ) { | |
444 | print STDERR ("=> \$\$L{$opt} += \"$arg\"\n") | |
445 | if $debug; | |
446 | if ( defined ${$linkage{$opt}} ) { | |
447 | ${$linkage{$opt}} += $arg; | |
448 | } | |
449 | else { | |
450 | ${$linkage{$opt}} = $arg; | |
451 | } | |
452 | } | |
453 | else { | |
454 | print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") | |
455 | if $debug; | |
456 | ${$linkage{$opt}} = $arg; | |
457 | } | |
458 | } | |
459 | elsif ( ref($linkage{$opt}) eq 'ARRAY' ) { | |
460 | print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") | |
461 | if $debug; | |
462 | push (@{$linkage{$opt}}, $arg); | |
463 | } | |
464 | elsif ( ref($linkage{$opt}) eq 'HASH' ) { | |
465 | print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") | |
466 | if $debug; | |
467 | $linkage{$opt}->{$key} = $arg; | |
468 | } | |
469 | elsif ( ref($linkage{$opt}) eq 'CODE' ) { | |
470 | print STDERR ("=> &L{$opt}(\"$opt\"", | |
471 | $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "", | |
472 | ", \"$arg\")\n") | |
473 | if $debug; | |
474 | my $eval_error = do { | |
475 | local $@; | |
476 | local $SIG{__DIE__} = '__DEFAULT__'; | |
477 | eval { | |
478 | &{$linkage{$opt}}($opt, | |
479 | $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (), | |
480 | $arg); | |
481 | }; | |
482 | $@; | |
483 | }; | |
484 | print STDERR ("=> die($eval_error)\n") | |
485 | if $debug && $eval_error ne ''; | |
486 | if ( $eval_error =~ /^!/ ) { | |
487 | if ( $eval_error =~ /^!FINISH\b/ ) { | |
488 | $goon = 0; | |
489 | } | |
490 | } | |
491 | elsif ( $eval_error ne '' ) { | |
492 | warn ($eval_error); | |
493 | $error++; | |
494 | } | |
495 | } | |
496 | else { | |
497 | print STDERR ("Invalid REF type \"", ref($linkage{$opt}), | |
498 | "\" in linkage\n"); | |
499 | die("Getopt::Long -- internal error!\n"); | |
500 | } | |
501 | } | |
502 | # No entry in linkage means entry in userlinkage. | |
503 | elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) { | |
504 | if ( defined $userlinkage->{$opt} ) { | |
505 | print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n") | |
506 | if $debug; | |
507 | push (@{$userlinkage->{$opt}}, $arg); | |
508 | } | |
509 | else { | |
510 | print STDERR ("=>\$L{$opt} = [\"$arg\"]\n") | |
511 | if $debug; | |
512 | $userlinkage->{$opt} = [$arg]; | |
513 | } | |
514 | } | |
515 | elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) { | |
516 | if ( defined $userlinkage->{$opt} ) { | |
517 | print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n") | |
518 | if $debug; | |
519 | $userlinkage->{$opt}->{$key} = $arg; | |
520 | } | |
521 | else { | |
522 | print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n") | |
523 | if $debug; | |
524 | $userlinkage->{$opt} = {$key => $arg}; | |
525 | } | |
526 | } | |
527 | else { | |
528 | if ( $ctl->[CTL_TYPE] eq '+' ) { | |
529 | print STDERR ("=> \$L{$opt} += \"$arg\"\n") | |
530 | if $debug; | |
531 | if ( defined $userlinkage->{$opt} ) { | |
532 | $userlinkage->{$opt} += $arg; | |
533 | } | |
534 | else { | |
535 | $userlinkage->{$opt} = $arg; | |
536 | } | |
537 | } | |
538 | else { | |
539 | print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug; | |
540 | $userlinkage->{$opt} = $arg; | |
541 | } | |
542 | } | |
543 | } | |
544 | } | |
545 | ||
546 | # Not an option. Save it if we $PERMUTE and don't have a <>. | |
547 | elsif ( $order == $PERMUTE ) { | |
548 | # Try non-options call-back. | |
549 | my $cb; | |
550 | if ( (defined ($cb = $linkage{'<>'})) ) { | |
551 | print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n") | |
552 | if $debug; | |
553 | my $eval_error = do { | |
554 | local $@; | |
555 | local $SIG{__DIE__} = '__DEFAULT__'; | |
556 | eval { &$cb ($tryopt) }; | |
557 | $@; | |
558 | }; | |
559 | print STDERR ("=> die($eval_error)\n") | |
560 | if $debug && $eval_error ne ''; | |
561 | if ( $eval_error =~ /^!/ ) { | |
562 | if ( $eval_error =~ /^!FINISH\b/ ) { | |
563 | $goon = 0; | |
564 | } | |
565 | } | |
566 | elsif ( $eval_error ne '' ) { | |
567 | warn ($eval_error); | |
568 | $error++; | |
569 | } | |
570 | } | |
571 | else { | |
572 | print STDERR ("=> saving \"$tryopt\" ", | |
573 | "(not an option, may permute)\n") if $debug; | |
574 | push (@ret, $tryopt); | |
575 | } | |
576 | next; | |
577 | } | |
578 | ||
579 | # ...otherwise, terminate. | |
580 | else { | |
581 | # Push this one back and exit. | |
582 | unshift (@ARGV, $tryopt); | |
583 | return ($error == 0); | |
584 | } | |
585 | ||
586 | } | |
587 | ||
588 | # Finish. | |
589 | if ( @ret && $order == $PERMUTE ) { | |
590 | # Push back accumulated arguments | |
591 | print STDERR ("=> restoring \"", join('" "', @ret), "\"\n") | |
592 | if $debug; | |
593 | unshift (@ARGV, @ret); | |
594 | } | |
595 | ||
596 | return ($error == 0); | |
597 | } | |
598 | ||
599 | # A readable representation of what's in an optbl. | |
600 | sub OptCtl ($) { | |
601 | my ($v) = @_; | |
602 | my @v = map { defined($_) ? ($_) : ("<undef>") } @$v; | |
603 | "[". | |
604 | join(",", | |
605 | "\"$v[CTL_TYPE]\"", | |
606 | "\"$v[CTL_CNAME]\"", | |
607 | $v[CTL_MAND] ? "O" : "M", | |
608 | ("\$","\@","\%","\&")[$v[CTL_DEST] || 0], | |
609 | "\"$v[CTL_DEFAULT]\"", | |
610 | # $v[CTL_RANGE] || '', | |
611 | # $v[CTL_REPEAT] || '', | |
612 | ). "]"; | |
613 | } | |
614 | ||
615 | # Parse an option specification and fill the tables. | |
616 | sub ParseOptionSpec ($$) { | |
617 | my ($opt, $opctl) = @_; | |
618 | ||
619 | # Match option spec. | |
620 | if ( $opt !~ m;^ | |
621 | ( | |
622 | # Option name | |
623 | (?: \w+[-\w]* ) | |
624 | # Alias names, or "?" | |
625 | (?: \| (?: \? | \w[-\w]* )? )* | |
626 | )? | |
627 | ( | |
628 | # Either modifiers ... | |
629 | [!+] | |
630 | | | |
631 | # ... or a value/dest specification | |
632 | [=:] [ionfs] [@%]? | |
633 | | | |
634 | # ... or an optional-with-default spec | |
635 | : (?: -?\d+ | \+ ) [@%]? | |
636 | )? | |
637 | $;x ) { | |
638 | return (undef, "Error in option spec: \"$opt\"\n"); | |
639 | } | |
640 | ||
641 | my ($names, $spec) = ($1, $2); | |
642 | $spec = '' unless defined $spec; | |
643 | ||
644 | # $orig keeps track of the primary name the user specified. | |
645 | # This name will be used for the internal or external linkage. | |
646 | # In other words, if the user specifies "FoO|BaR", it will | |
647 | # match any case combinations of 'foo' and 'bar', but if a global | |
648 | # variable needs to be set, it will be $opt_FoO in the exact case | |
649 | # as specified. | |
650 | my $orig; | |
651 | ||
652 | my @names; | |
653 | if ( defined $names ) { | |
654 | @names = split (/\|/, $names); | |
655 | $orig = $names[0]; | |
656 | } | |
657 | else { | |
658 | @names = (''); | |
659 | $orig = ''; | |
660 | } | |
661 | ||
662 | # Construct the opctl entries. | |
663 | my $entry; | |
664 | if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) { | |
665 | # Fields are hard-wired here. | |
666 | $entry = [$spec,$orig,0,CTL_DEST_SCALAR,undef]; | |
667 | } | |
668 | elsif ( $spec =~ /:(-?\d+|\+)([@%])?/ ) { | |
669 | my $def = $1; | |
670 | my $dest = $2; | |
671 | my $type = $def eq '+' ? 'I' : 'i'; | |
672 | $dest ||= '$'; | |
673 | $dest = $dest eq '@' ? CTL_DEST_ARRAY | |
674 | : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; | |
675 | # Fields are hard-wired here. | |
676 | $entry = [$type,$orig,0,$dest,$def eq '+' ? undef : $def]; | |
677 | } | |
678 | else { | |
679 | my ($mand, $type, $dest) = $spec =~ /([=:])([ionfs])([@%])?/; | |
680 | $type = 'i' if $type eq 'n'; | |
681 | $dest ||= '$'; | |
682 | $dest = $dest eq '@' ? CTL_DEST_ARRAY | |
683 | : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR; | |
684 | # Fields are hard-wired here. | |
685 | $entry = [$type,$orig,$mand eq '=',$dest,undef]; | |
686 | } | |
687 | ||
688 | # Process all names. First is canonical, the rest are aliases. | |
689 | my $dups = ''; | |
690 | foreach ( @names ) { | |
691 | ||
692 | $_ = lc ($_) | |
693 | if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0); | |
694 | ||
695 | if ( exists $opctl->{$_} ) { | |
696 | $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n"; | |
697 | } | |
698 | ||
699 | if ( $spec eq '!' ) { | |
700 | $opctl->{"no$_"} = $entry; | |
701 | $opctl->{$_} = [@$entry]; | |
702 | $opctl->{$_}->[CTL_TYPE] = ''; | |
703 | } | |
704 | else { | |
705 | $opctl->{$_} = $entry; | |
706 | } | |
707 | } | |
708 | ||
709 | if ( $dups && $^W ) { | |
710 | foreach ( split(/\n+/, $dups) ) { | |
711 | warn($_."\n"); | |
712 | } | |
713 | } | |
714 | ($names[0], $orig); | |
715 | } | |
716 | ||
717 | # Option lookup. | |
718 | sub FindOption ($$$$) { | |
719 | ||
720 | # returns (1, $opt, $ctl, $arg, $key) if okay, | |
721 | # returns (1, undef) if option in error, | |
722 | # returns (0) otherwise. | |
723 | ||
724 | my ($prefix, $argend, $opt, $opctl) = @_; | |
725 | ||
726 | print STDERR ("=> find \"$opt\"\n") if $debug; | |
727 | ||
728 | return (0) unless $opt =~ /^$prefix(.*)$/s; | |
729 | return (0) if $opt eq "-" && !defined $opctl->{''}; | |
730 | ||
731 | $opt = $+; | |
732 | my $starter = $1; | |
733 | ||
734 | print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug; | |
735 | ||
736 | my $optarg; # value supplied with --opt=value | |
737 | my $rest; # remainder from unbundling | |
738 | ||
739 | # If it is a long option, it may include the value. | |
740 | # With getopt_compat, only if not bundling. | |
741 | if ( ($starter eq "--" | |
742 | || ($getopt_compat && ($bundling == 0 || $bundling == 2))) | |
743 | && $opt =~ /^([^=]+)=(.*)$/s ) { | |
744 | $opt = $1; | |
745 | $optarg = $2; | |
746 | print STDERR ("=> option \"", $opt, | |
747 | "\", optarg = \"$optarg\"\n") if $debug; | |
748 | } | |
749 | ||
750 | #### Look it up ### | |
751 | ||
752 | my $tryopt = $opt; # option to try | |
753 | ||
754 | if ( $bundling && $starter eq '-' ) { | |
755 | ||
756 | # To try overrides, obey case ignore. | |
757 | $tryopt = $ignorecase ? lc($opt) : $opt; | |
758 | ||
759 | # If bundling == 2, long options can override bundles. | |
760 | if ( $bundling == 2 && length($tryopt) > 1 | |
761 | && defined ($opctl->{$tryopt}) ) { | |
762 | print STDERR ("=> $starter$tryopt overrides unbundling\n") | |
763 | if $debug; | |
764 | } | |
765 | else { | |
766 | $tryopt = $opt; | |
767 | # Unbundle single letter option. | |
768 | $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : ''; | |
769 | $tryopt = substr ($tryopt, 0, 1); | |
770 | $tryopt = lc ($tryopt) if $ignorecase > 1; | |
771 | print STDERR ("=> $starter$tryopt unbundled from ", | |
772 | "$starter$tryopt$rest\n") if $debug; | |
773 | $rest = undef unless $rest ne ''; | |
774 | } | |
775 | } | |
776 | ||
777 | # Try auto-abbreviation. | |
778 | elsif ( $autoabbrev ) { | |
779 | # Sort the possible long option names. | |
780 | my @names = sort(keys (%$opctl)); | |
781 | # Downcase if allowed. | |
782 | $opt = lc ($opt) if $ignorecase; | |
783 | $tryopt = $opt; | |
784 | # Turn option name into pattern. | |
785 | my $pat = quotemeta ($opt); | |
786 | # Look up in option names. | |
787 | my @hits = grep (/^$pat/, @names); | |
788 | print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ", | |
789 | "out of ", scalar(@names), "\n") if $debug; | |
790 | ||
791 | # Check for ambiguous results. | |
792 | unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { | |
793 | # See if all matches are for the same option. | |
794 | my %hit; | |
795 | foreach ( @hits ) { | |
796 | $_ = $opctl->{$_}->[CTL_CNAME] | |
797 | if defined $opctl->{$_}->[CTL_CNAME]; | |
798 | $hit{$_} = 1; | |
799 | } | |
800 | # Now see if it really is ambiguous. | |
801 | unless ( keys(%hit) == 1 ) { | |
802 | return (0) if $passthrough; | |
803 | warn ("Option ", $opt, " is ambiguous (", | |
804 | join(", ", @hits), ")\n"); | |
805 | $error++; | |
806 | return (1, undef); | |
807 | } | |
808 | @hits = keys(%hit); | |
809 | } | |
810 | ||
811 | # Complete the option name, if appropriate. | |
812 | if ( @hits == 1 && $hits[0] ne $opt ) { | |
813 | $tryopt = $hits[0]; | |
814 | $tryopt = lc ($tryopt) if $ignorecase; | |
815 | print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") | |
816 | if $debug; | |
817 | } | |
818 | } | |
819 | ||
820 | # Map to all lowercase if ignoring case. | |
821 | elsif ( $ignorecase ) { | |
822 | $tryopt = lc ($opt); | |
823 | } | |
824 | ||
825 | # Check validity by fetching the info. | |
826 | my $ctl = $opctl->{$tryopt}; | |
827 | unless ( defined $ctl ) { | |
828 | return (0) if $passthrough; | |
829 | warn ("Unknown option: ", $opt, "\n"); | |
830 | $error++; | |
831 | return (1, undef); | |
832 | } | |
833 | # Apparently valid. | |
834 | $opt = $tryopt; | |
835 | print STDERR ("=> found ", OptCtl($ctl), | |
836 | " for \"", $opt, "\"\n") if $debug; | |
837 | ||
838 | #### Determine argument status #### | |
839 | ||
840 | # If it is an option w/o argument, we're almost finished with it. | |
841 | my $type = $ctl->[CTL_TYPE]; | |
842 | my $arg; | |
843 | ||
844 | if ( $type eq '' || $type eq '!' || $type eq '+' ) { | |
845 | if ( defined $optarg ) { | |
846 | return (0) if $passthrough; | |
847 | warn ("Option ", $opt, " does not take an argument\n"); | |
848 | $error++; | |
849 | undef $opt; | |
850 | } | |
851 | elsif ( $type eq '' || $type eq '+' ) { | |
852 | # Supply explicit value. | |
853 | $arg = 1; | |
854 | } | |
855 | else { | |
856 | $opt =~ s/^no//i; # strip NO prefix | |
857 | $arg = 0; # supply explicit value | |
858 | } | |
859 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
860 | return (1, $opt, $ctl, $arg); | |
861 | } | |
862 | ||
863 | # Get mandatory status and type info. | |
864 | my $mand = $ctl->[CTL_MAND]; | |
865 | ||
866 | # Check if there is an option argument available. | |
867 | if ( $gnu_compat && defined $optarg && $optarg eq '' ) { | |
868 | return (1, $opt, $ctl, $type eq 's' ? '' : 0) unless $mand; | |
869 | $optarg = 0 unless $type eq 's'; | |
870 | } | |
871 | ||
872 | # Check if there is an option argument available. | |
873 | if ( defined $optarg | |
874 | ? ($optarg eq '') | |
875 | : !(defined $rest || @ARGV > 0) ) { | |
876 | # Complain if this option needs an argument. | |
877 | if ( $mand ) { | |
878 | return (0) if $passthrough; | |
879 | warn ("Option ", $opt, " requires an argument\n"); | |
880 | $error++; | |
881 | return (1, undef); | |
882 | } | |
883 | if ( $type eq 'I' ) { | |
884 | # Fake incremental type. | |
885 | my @c = @$ctl; | |
886 | $c[CTL_TYPE] = '+'; | |
887 | return (1, $opt, \@c, 1); | |
888 | } | |
889 | return (1, $opt, $ctl, | |
890 | defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : | |
891 | $type eq 's' ? '' : 0); | |
892 | } | |
893 | ||
894 | # Get (possibly optional) argument. | |
895 | $arg = (defined $rest ? $rest | |
896 | : (defined $optarg ? $optarg : shift (@ARGV))); | |
897 | ||
898 | # Get key if this is a "name=value" pair for a hash option. | |
899 | my $key; | |
900 | if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) { | |
901 | ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) | |
902 | : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 1); | |
903 | } | |
904 | ||
905 | #### Check if the argument is valid for this option #### | |
906 | ||
907 | if ( $type eq 's' ) { # string | |
908 | # A mandatory string takes anything. | |
909 | return (1, $opt, $ctl, $arg, $key) if $mand; | |
910 | ||
911 | # An optional string takes almost anything. | |
912 | return (1, $opt, $ctl, $arg, $key) | |
913 | if defined $optarg || defined $rest; | |
914 | return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ?? | |
915 | ||
916 | # Check for option or option list terminator. | |
917 | if ($arg eq $argend || | |
918 | $arg =~ /^$prefix.+/) { | |
919 | # Push back. | |
920 | unshift (@ARGV, $arg); | |
921 | # Supply empty value. | |
922 | $arg = ''; | |
923 | } | |
924 | } | |
925 | ||
926 | elsif ( $type eq 'i' # numeric/integer | |
927 | || $type eq 'I' # numeric/integer w/ incr default | |
928 | || $type eq 'o' ) { # dec/oct/hex/bin value | |
929 | ||
930 | my $o_valid = | |
931 | $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*" | |
932 | : "[-+]?[0-9]+"; | |
933 | ||
934 | if ( $bundling && defined $rest && $rest =~ /^($o_valid)(.*)$/si ) { | |
935 | $arg = $1; | |
936 | $rest = $2; | |
937 | $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg; | |
938 | unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; | |
939 | } | |
940 | elsif ( $arg =~ /^($o_valid)$/si ) { | |
941 | $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg; | |
942 | } | |
943 | else { | |
944 | if ( defined $optarg || $mand ) { | |
945 | if ( $passthrough ) { | |
946 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg) | |
947 | unless defined $optarg; | |
948 | return (0); | |
949 | } | |
950 | warn ("Value \"", $arg, "\" invalid for option ", | |
951 | $opt, " (", | |
952 | $type eq 'o' ? "extended " : '', | |
953 | "number expected)\n"); | |
954 | $error++; | |
955 | # Push back. | |
956 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
957 | return (1, undef); | |
958 | } | |
959 | else { | |
960 | # Push back. | |
961 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
962 | if ( $type eq 'I' ) { | |
963 | # Fake incremental type. | |
964 | my @c = @$ctl; | |
965 | $c[CTL_TYPE] = '+'; | |
966 | return (1, $opt, \@c, 1); | |
967 | } | |
968 | # Supply default value. | |
969 | $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0; | |
970 | } | |
971 | } | |
972 | } | |
973 | ||
974 | elsif ( $type eq 'f' ) { # real number, int is also ok | |
975 | # We require at least one digit before a point or 'e', | |
976 | # and at least one digit following the point and 'e'. | |
977 | # [-]NN[.NN][eNN] | |
978 | if ( $bundling && defined $rest && | |
979 | $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) { | |
980 | $arg = $1; | |
981 | $rest = $+; | |
982 | unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne ''; | |
983 | } | |
984 | elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) { | |
985 | if ( defined $optarg || $mand ) { | |
986 | if ( $passthrough ) { | |
987 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg) | |
988 | unless defined $optarg; | |
989 | return (0); | |
990 | } | |
991 | warn ("Value \"", $arg, "\" invalid for option ", | |
992 | $opt, " (real number expected)\n"); | |
993 | $error++; | |
994 | # Push back. | |
995 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
996 | return (1, undef); | |
997 | } | |
998 | else { | |
999 | # Push back. | |
1000 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
1001 | # Supply default value. | |
1002 | $arg = 0.0; | |
1003 | } | |
1004 | } | |
1005 | } | |
1006 | else { | |
1007 | die("GetOpt::Long internal error (Can't happen)\n"); | |
1008 | } | |
1009 | return (1, $opt, $ctl, $arg, $key); | |
1010 | } | |
1011 | ||
1012 | # Getopt::Long Configuration. | |
1013 | sub Configure (@) { | |
1014 | my (@options) = @_; | |
1015 | ||
1016 | my $prevconfig = | |
1017 | [ $error, $debug, $major_version, $minor_version, | |
1018 | $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, | |
1019 | $gnu_compat, $passthrough, $genprefix ]; | |
1020 | ||
1021 | if ( ref($options[0]) eq 'ARRAY' ) { | |
1022 | ( $error, $debug, $major_version, $minor_version, | |
1023 | $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order, | |
1024 | $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)}; | |
1025 | } | |
1026 | ||
1027 | my $opt; | |
1028 | foreach $opt ( @options ) { | |
1029 | my $try = lc ($opt); | |
1030 | my $action = 1; | |
1031 | if ( $try =~ /^no_?(.*)$/s ) { | |
1032 | $action = 0; | |
1033 | $try = $+; | |
1034 | } | |
1035 | if ( ($try eq 'default' or $try eq 'defaults') && $action ) { | |
1036 | ConfigDefaults (); | |
1037 | } | |
1038 | elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) { | |
1039 | local $ENV{POSIXLY_CORRECT}; | |
1040 | $ENV{POSIXLY_CORRECT} = 1 if $action; | |
1041 | ConfigDefaults (); | |
1042 | } | |
1043 | elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) { | |
1044 | $autoabbrev = $action; | |
1045 | } | |
1046 | elsif ( $try eq 'getopt_compat' ) { | |
1047 | $getopt_compat = $action; | |
1048 | } | |
1049 | elsif ( $try eq 'gnu_getopt' ) { | |
1050 | if ( $action ) { | |
1051 | $gnu_compat = 1; | |
1052 | $bundling = 1; | |
1053 | $getopt_compat = 0; | |
1054 | $order = $PERMUTE; | |
1055 | } | |
1056 | } | |
1057 | elsif ( $try eq 'gnu_compat' ) { | |
1058 | $gnu_compat = $action; | |
1059 | } | |
1060 | elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) { | |
1061 | $ignorecase = $action; | |
1062 | } | |
1063 | elsif ( $try eq 'ignore_case_always' ) { | |
1064 | $ignorecase = $action ? 2 : 0; | |
1065 | } | |
1066 | elsif ( $try eq 'bundling' ) { | |
1067 | $bundling = $action; | |
1068 | } | |
1069 | elsif ( $try eq 'bundling_override' ) { | |
1070 | $bundling = $action ? 2 : 0; | |
1071 | } | |
1072 | elsif ( $try eq 'require_order' ) { | |
1073 | $order = $action ? $REQUIRE_ORDER : $PERMUTE; | |
1074 | } | |
1075 | elsif ( $try eq 'permute' ) { | |
1076 | $order = $action ? $PERMUTE : $REQUIRE_ORDER; | |
1077 | } | |
1078 | elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) { | |
1079 | $passthrough = $action; | |
1080 | } | |
1081 | elsif ( $try =~ /^prefix=(.+)$/ && $action ) { | |
1082 | $genprefix = $1; | |
1083 | # Turn into regexp. Needs to be parenthesized! | |
1084 | $genprefix = "(" . quotemeta($genprefix) . ")"; | |
1085 | eval { '' =~ /$genprefix/; }; | |
1086 | die("Getopt::Long: invalid pattern \"$genprefix\"") if $@; | |
1087 | } | |
1088 | elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) { | |
1089 | $genprefix = $1; | |
1090 | # Parenthesize if needed. | |
1091 | $genprefix = "(" . $genprefix . ")" | |
1092 | unless $genprefix =~ /^\(.*\)$/; | |
1093 | eval { '' =~ /$genprefix/; }; | |
1094 | die("Getopt::Long: invalid pattern \"$genprefix\"") if $@; | |
1095 | } | |
1096 | elsif ( $try eq 'debug' ) { | |
1097 | $debug = $action; | |
1098 | } | |
1099 | else { | |
1100 | die("Getopt::Long: unknown config parameter \"$opt\"") | |
1101 | } | |
1102 | } | |
1103 | $prevconfig; | |
1104 | } | |
1105 | ||
1106 | # Deprecated name. | |
1107 | sub config (@) { | |
1108 | Configure (@_); | |
1109 | } | |
1110 | ||
1111 | ################ Documentation ################ | |
1112 | ||
1113 | =head1 NAME | |
1114 | ||
1115 | Getopt::Long - Extended processing of command line options | |
1116 | ||
1117 | =head1 SYNOPSIS | |
1118 | ||
1119 | use Getopt::Long; | |
1120 | my $data = "file.dat"; | |
1121 | my $length = 24; | |
1122 | my $verbose; | |
1123 | $result = GetOptions ("length=i" => \$length, # numeric | |
1124 | "file=s" => \$data, # string | |
1125 | "verbose" => \$verbose); # flag | |
1126 | ||
1127 | =head1 DESCRIPTION | |
1128 | ||
1129 | The Getopt::Long module implements an extended getopt function called | |
1130 | GetOptions(). This function adheres to the POSIX syntax for command | |
1131 | line options, with GNU extensions. In general, this means that options | |
1132 | have long names instead of single letters, and are introduced with a | |
1133 | double dash "--". Support for bundling of command line options, as was | |
1134 | the case with the more traditional single-letter approach, is provided | |
1135 | but not enabled by default. | |
1136 | ||
1137 | =head1 Command Line Options, an Introduction | |
1138 | ||
1139 | Command line operated programs traditionally take their arguments from | |
1140 | the command line, for example filenames or other information that the | |
1141 | program needs to know. Besides arguments, these programs often take | |
1142 | command line I<options> as well. Options are not necessary for the | |
1143 | program to work, hence the name 'option', but are used to modify its | |
1144 | default behaviour. For example, a program could do its job quietly, | |
1145 | but with a suitable option it could provide verbose information about | |
1146 | what it did. | |
1147 | ||
1148 | Command line options come in several flavours. Historically, they are | |
1149 | preceded by a single dash C<->, and consist of a single letter. | |
1150 | ||
1151 | -l -a -c | |
1152 | ||
1153 | Usually, these single-character options can be bundled: | |
1154 | ||
1155 | -lac | |
1156 | ||
1157 | Options can have values, the value is placed after the option | |
1158 | character. Sometimes with whitespace in between, sometimes not: | |
1159 | ||
1160 | -s 24 -s24 | |
1161 | ||
1162 | Due to the very cryptic nature of these options, another style was | |
1163 | developed that used long names. So instead of a cryptic C<-l> one | |
1164 | could use the more descriptive C<--long>. To distinguish between a | |
1165 | bundle of single-character options and a long one, two dashes are used | |
1166 | to precede the option name. Early implementations of long options used | |
1167 | a plus C<+> instead. Also, option values could be specified either | |
1168 | like | |
1169 | ||
1170 | --size=24 | |
1171 | ||
1172 | or | |
1173 | ||
1174 | --size 24 | |
1175 | ||
1176 | The C<+> form is now obsolete and strongly deprecated. | |
1177 | ||
1178 | =head1 Getting Started with Getopt::Long | |
1179 | ||
1180 | Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was | |
1181 | the first Perl module that provided support for handling the new style | |
1182 | of command line options, hence the name Getopt::Long. This module | |
1183 | also supports single-character options and bundling. In this case, the | |
1184 | options are restricted to alphabetic characters only, and the | |
1185 | characters C<?> and C<->. | |
1186 | ||
1187 | To use Getopt::Long from a Perl program, you must include the | |
1188 | following line in your Perl program: | |
1189 | ||
1190 | use Getopt::Long; | |
1191 | ||
1192 | This will load the core of the Getopt::Long module and prepare your | |
1193 | program for using it. Most of the actual Getopt::Long code is not | |
1194 | loaded until you really call one of its functions. | |
1195 | ||
1196 | In the default configuration, options names may be abbreviated to | |
1197 | uniqueness, case does not matter, and a single dash is sufficient, | |
1198 | even for long option names. Also, options may be placed between | |
1199 | non-option arguments. See L<Configuring Getopt::Long> for more | |
1200 | details on how to configure Getopt::Long. | |
1201 | ||
1202 | =head2 Simple options | |
1203 | ||
1204 | The most simple options are the ones that take no values. Their mere | |
1205 | presence on the command line enables the option. Popular examples are: | |
1206 | ||
1207 | --all --verbose --quiet --debug | |
1208 | ||
1209 | Handling simple options is straightforward: | |
1210 | ||
1211 | my $verbose = ''; # option variable with default value (false) | |
1212 | my $all = ''; # option variable with default value (false) | |
1213 | GetOptions ('verbose' => \$verbose, 'all' => \$all); | |
1214 | ||
1215 | The call to GetOptions() parses the command line arguments that are | |
1216 | present in C<@ARGV> and sets the option variable to the value C<1> if | |
1217 | the option did occur on the command line. Otherwise, the option | |
1218 | variable is not touched. Setting the option value to true is often | |
1219 | called I<enabling> the option. | |
1220 | ||
1221 | The option name as specified to the GetOptions() function is called | |
1222 | the option I<specification>. Later we'll see that this specification | |
1223 | can contain more than just the option name. The reference to the | |
1224 | variable is called the option I<destination>. | |
1225 | ||
1226 | GetOptions() will return a true value if the command line could be | |
1227 | processed successfully. Otherwise, it will write error messages to | |
1228 | STDERR, and return a false result. | |
1229 | ||
1230 | =head2 A little bit less simple options | |
1231 | ||
1232 | Getopt::Long supports two useful variants of simple options: | |
1233 | I<negatable> options and I<incremental> options. | |
1234 | ||
1235 | A negatable option is specified with an exclamation mark C<!> after the | |
1236 | option name: | |
1237 | ||
1238 | my $verbose = ''; # option variable with default value (false) | |
1239 | GetOptions ('verbose!' => \$verbose); | |
1240 | ||
1241 | Now, using C<--verbose> on the command line will enable C<$verbose>, | |
1242 | as expected. But it is also allowed to use C<--noverbose>, which will | |
1243 | disable C<$verbose> by setting its value to C<0>. Using a suitable | |
1244 | default value, the program can find out whether C<$verbose> is false | |
1245 | by default, or disabled by using C<--noverbose>. | |
1246 | ||
1247 | An incremental option is specified with a plus C<+> after the | |
1248 | option name: | |
1249 | ||
1250 | my $verbose = ''; # option variable with default value (false) | |
1251 | GetOptions ('verbose+' => \$verbose); | |
1252 | ||
1253 | Using C<--verbose> on the command line will increment the value of | |
1254 | C<$verbose>. This way the program can keep track of how many times the | |
1255 | option occurred on the command line. For example, each occurrence of | |
1256 | C<--verbose> could increase the verbosity level of the program. | |
1257 | ||
1258 | =head2 Mixing command line option with other arguments | |
1259 | ||
1260 | Usually programs take command line options as well as other arguments, | |
1261 | for example, file names. It is good practice to always specify the | |
1262 | options first, and the other arguments last. Getopt::Long will, | |
1263 | however, allow the options and arguments to be mixed and 'filter out' | |
1264 | all the options before passing the rest of the arguments to the | |
1265 | program. To stop Getopt::Long from processing further arguments, | |
1266 | insert a double dash C<--> on the command line: | |
1267 | ||
1268 | --size 24 -- --all | |
1269 | ||
1270 | In this example, C<--all> will I<not> be treated as an option, but | |
1271 | passed to the program unharmed, in C<@ARGV>. | |
1272 | ||
1273 | =head2 Options with values | |
1274 | ||
1275 | For options that take values it must be specified whether the option | |
1276 | value is required or not, and what kind of value the option expects. | |
1277 | ||
1278 | Three kinds of values are supported: integer numbers, floating point | |
1279 | numbers, and strings. | |
1280 | ||
1281 | If the option value is required, Getopt::Long will take the | |
1282 | command line argument that follows the option and assign this to the | |
1283 | option variable. If, however, the option value is specified as | |
1284 | optional, this will only be done if that value does not look like a | |
1285 | valid command line option itself. | |
1286 | ||
1287 | my $tag = ''; # option variable with default value | |
1288 | GetOptions ('tag=s' => \$tag); | |
1289 | ||
1290 | In the option specification, the option name is followed by an equals | |
1291 | sign C<=> and the letter C<s>. The equals sign indicates that this | |
1292 | option requires a value. The letter C<s> indicates that this value is | |
1293 | an arbitrary string. Other possible value types are C<i> for integer | |
1294 | values, and C<f> for floating point values. Using a colon C<:> instead | |
1295 | of the equals sign indicates that the option value is optional. In | |
1296 | this case, if no suitable value is supplied, string valued options get | |
1297 | an empty string C<''> assigned, while numeric options are set to C<0>. | |
1298 | ||
1299 | =head2 Options with multiple values | |
1300 | ||
1301 | Options sometimes take several values. For example, a program could | |
1302 | use multiple directories to search for library files: | |
1303 | ||
1304 | --library lib/stdlib --library lib/extlib | |
1305 | ||
1306 | To accomplish this behaviour, simply specify an array reference as the | |
1307 | destination for the option: | |
1308 | ||
1309 | my @libfiles = (); | |
1310 | GetOptions ("library=s" => \@libfiles); | |
1311 | ||
1312 | Used with the example above, C<@libfiles> would contain two strings | |
1313 | upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order. | |
1314 | It is also possible to specify that only integer or floating point | |
1315 | numbers are acceptible values. | |
1316 | ||
1317 | Often it is useful to allow comma-separated lists of values as well as | |
1318 | multiple occurrences of the options. This is easy using Perl's split() | |
1319 | and join() operators: | |
1320 | ||
1321 | my @libfiles = (); | |
1322 | GetOptions ("library=s" => \@libfiles); | |
1323 | @libfiles = split(/,/,join(',',@libfiles)); | |
1324 | ||
1325 | Of course, it is important to choose the right separator string for | |
1326 | each purpose. | |
1327 | ||
1328 | =head2 Options with hash values | |
1329 | ||
1330 | If the option destination is a reference to a hash, the option will | |
1331 | take, as value, strings of the form I<key>C<=>I<value>. The value will | |
1332 | be stored with the specified key in the hash. | |
1333 | ||
1334 | my %defines = (); | |
1335 | GetOptions ("define=s" => \%defines); | |
1336 | ||
1337 | When used with command line options: | |
1338 | ||
1339 | --define os=linux --define vendor=redhat | |
1340 | ||
1341 | the hash C<%defines> will contain two keys, C<"os"> with value | |
1342 | C<"linux> and C<"vendor"> with value C<"redhat">. | |
1343 | It is also possible to specify that only integer or floating point | |
1344 | numbers are acceptible values. The keys are always taken to be strings. | |
1345 | ||
1346 | =head2 User-defined subroutines to handle options | |
1347 | ||
1348 | Ultimate control over what should be done when (actually: each time) | |
1349 | an option is encountered on the command line can be achieved by | |
1350 | designating a reference to a subroutine (or an anonymous subroutine) | |
1351 | as the option destination. When GetOptions() encounters the option, it | |
1352 | will call the subroutine with two or three arguments. The first | |
1353 | argument is the name of the option. For a scalar or array destination, | |
1354 | the second argument is the value to be stored. For a hash destination, | |
1355 | the second arguments is the key to the hash, and the third argument | |
1356 | the value to be stored. It is up to the subroutine to store the value, | |
1357 | or do whatever it thinks is appropriate. | |
1358 | ||
1359 | A trivial application of this mechanism is to implement options that | |
1360 | are related to each other. For example: | |
1361 | ||
1362 | my $verbose = ''; # option variable with default value (false) | |
1363 | GetOptions ('verbose' => \$verbose, | |
1364 | 'quiet' => sub { $verbose = 0 }); | |
1365 | ||
1366 | Here C<--verbose> and C<--quiet> control the same variable | |
1367 | C<$verbose>, but with opposite values. | |
1368 | ||
1369 | If the subroutine needs to signal an error, it should call die() with | |
1370 | the desired error message as its argument. GetOptions() will catch the | |
1371 | die(), issue the error message, and record that an error result must | |
1372 | be returned upon completion. | |
1373 | ||
1374 | If the text of the error message starts with an exclamantion mark C<!> | |
1375 | it is interpreted specially by GetOptions(). There is currently one | |
1376 | special command implemented: C<die("!FINISH")> will cause GetOptions() | |
1377 | to stop processing options, as if it encountered a double dash C<-->. | |
1378 | ||
1379 | =head2 Options with multiple names | |
1380 | ||
1381 | Often it is user friendly to supply alternate mnemonic names for | |
1382 | options. For example C<--height> could be an alternate name for | |
1383 | C<--length>. Alternate names can be included in the option | |
1384 | specification, separated by vertical bar C<|> characters. To implement | |
1385 | the above example: | |
1386 | ||
1387 | GetOptions ('length|height=f' => \$length); | |
1388 | ||
1389 | The first name is called the I<primary> name, the other names are | |
1390 | called I<aliases>. | |
1391 | ||
1392 | Multiple alternate names are possible. | |
1393 | ||
1394 | =head2 Case and abbreviations | |
1395 | ||
1396 | Without additional configuration, GetOptions() will ignore the case of | |
1397 | option names, and allow the options to be abbreviated to uniqueness. | |
1398 | ||
1399 | GetOptions ('length|height=f' => \$length, "head" => \$head); | |
1400 | ||
1401 | This call will allow C<--l> and C<--L> for the length option, but | |
1402 | requires a least C<--hea> and C<--hei> for the head and height options. | |
1403 | ||
1404 | =head2 Summary of Option Specifications | |
1405 | ||
1406 | Each option specifier consists of two parts: the name specification | |
1407 | and the argument specification. | |
1408 | ||
1409 | The name specification contains the name of the option, optionally | |
1410 | followed by a list of alternative names separated by vertical bar | |
1411 | characters. | |
1412 | ||
1413 | length option name is "length" | |
1414 | length|size|l name is "length", aliases are "size" and "l" | |
1415 | ||
1416 | The argument specification is optional. If omitted, the option is | |
1417 | considered boolean, a value of 1 will be assigned when the option is | |
1418 | used on the command line. | |
1419 | ||
1420 | The argument specification can be | |
1421 | ||
1422 | =over 4 | |
1423 | ||
1424 | =item ! | |
1425 | ||
1426 | The option does not take an argument and may be negated, i.e. prefixed | |
1427 | by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be | |
1428 | assigned) and C<--nofoo> (a value of 0 will be assigned). If the | |
1429 | option has aliases, this applies to the aliases as well. | |
1430 | ||
1431 | Using negation on a single letter option when bundling is in effect is | |
1432 | pointless and will result in a warning. | |
1433 | ||
1434 | =item + | |
1435 | ||
1436 | The option does not take an argument and will be incremented by 1 | |
1437 | every time it appears on the command line. E.g. C<"more+">, when used | |
1438 | with C<--more --more --more>, will increment the value three times, | |
1439 | resulting in a value of 3 (provided it was 0 or undefined at first). | |
1440 | ||
1441 | The C<+> specifier is ignored if the option destination is not a scalar. | |
1442 | ||
1443 | =item = I<type> [ I<desttype> ] | |
1444 | ||
1445 | The option requires an argument of the given type. Supported types | |
1446 | are: | |
1447 | ||
1448 | =over 4 | |
1449 | ||
1450 | =item s | |
1451 | ||
1452 | String. An arbitrary sequence of characters. It is valid for the | |
1453 | argument to start with C<-> or C<-->. | |
1454 | ||
1455 | =item i | |
1456 | ||
1457 | Integer. An optional leading plus or minus sign, followed by a | |
1458 | sequence of digits. | |
1459 | ||
1460 | =item o | |
1461 | ||
1462 | Extended integer, Perl style. This can be either an optional leading | |
1463 | plus or minus sign, followed by a sequence of digits, or an octal | |
1464 | string (a zero, optionally followed by '0', '1', .. '7'), or a | |
1465 | hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case | |
1466 | insensitive), or a binary string (C<0b> followed by a series of '0' | |
1467 | and '1'). | |
1468 | ||
1469 | =item f | |
1470 | ||
1471 | Real number. For example C<3.14>, C<-6.23E24> and so on. | |
1472 | ||
1473 | =back | |
1474 | ||
1475 | The I<desttype> can be C<@> or C<%> to specify that the option is | |
1476 | list or a hash valued. This is only needed when the destination for | |
1477 | the option value is not otherwise specified. It should be omitted when | |
1478 | not needed. | |
1479 | ||
1480 | =item : I<type> [ I<desttype> ] | |
1481 | ||
1482 | Like C<=>, but designates the argument as optional. | |
1483 | If omitted, an empty string will be assigned to string values options, | |
1484 | and the value zero to numeric options. | |
1485 | ||
1486 | Note that if a string argument starts with C<-> or C<-->, it will be | |
1487 | considered an option on itself. | |
1488 | ||
1489 | =item : I<number> [ I<desttype> ] | |
1490 | ||
1491 | Like C<:i>, but if the value is omitted, the I<number> will be assigned. | |
1492 | ||
1493 | =item : + [ I<desttype> ] | |
1494 | ||
1495 | Like C<:i>, but if the value is omitted, the current value for the | |
1496 | option will be incremented. | |
1497 | ||
1498 | =back | |
1499 | ||
1500 | =head1 Advanced Possibilities | |
1501 | ||
1502 | =head2 Object oriented interface | |
1503 | ||
1504 | Getopt::Long can be used in an object oriented way as well: | |
1505 | ||
1506 | use Getopt::Long; | |
1507 | $p = new Getopt::Long::Parser; | |
1508 | $p->configure(...configuration options...); | |
1509 | if ($p->getoptions(...options descriptions...)) ... | |
1510 | ||
1511 | Configuration options can be passed to the constructor: | |
1512 | ||
1513 | $p = new Getopt::Long::Parser | |
1514 | config => [...configuration options...]; | |
1515 | ||
1516 | =head2 Thread Safety | |
1517 | ||
1518 | Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is | |
1519 | I<not> thread safe when using the older (experimental and now | |
1520 | obsolete) threads implementation that was added to Perl 5.005. | |
1521 | ||
1522 | =head2 Documentation and help texts | |
1523 | ||
1524 | Getopt::Long encourages the use of Pod::Usage to produce help | |
1525 | messages. For example: | |
1526 | ||
1527 | use Getopt::Long; | |
1528 | use Pod::Usage; | |
1529 | ||
1530 | my $man = 0; | |
1531 | my $help = 0; | |
1532 | ||
1533 | GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); | |
1534 | pod2usage(1) if $help; | |
1535 | pod2usage(-exitstatus => 0, -verbose => 2) if $man; | |
1536 | ||
1537 | __END__ | |
1538 | ||
1539 | =head1 NAME | |
1540 | ||
1541 | sample - Using GetOpt::Long and Pod::Usage | |
1542 | ||
1543 | =head1 SYNOPSIS | |
1544 | ||
1545 | sample [options] [file ...] | |
1546 | ||
1547 | Options: | |
1548 | -help brief help message | |
1549 | -man full documentation | |
1550 | ||
1551 | =head1 OPTIONS | |
1552 | ||
1553 | =over 8 | |
1554 | ||
1555 | =item B<-help> | |
1556 | ||
1557 | Print a brief help message and exits. | |
1558 | ||
1559 | =item B<-man> | |
1560 | ||
1561 | Prints the manual page and exits. | |
1562 | ||
1563 | =back | |
1564 | ||
1565 | =head1 DESCRIPTION | |
1566 | ||
1567 | B<This program> will read the given input file(s) and do someting | |
1568 | useful with the contents thereof. | |
1569 | ||
1570 | =cut | |
1571 | ||
1572 | See L<Pod::Usage> for details. | |
1573 | ||
1574 | =head2 Storing options in a hash | |
1575 | ||
1576 | Sometimes, for example when there are a lot of options, having a | |
1577 | separate variable for each of them can be cumbersome. GetOptions() | |
1578 | supports, as an alternative mechanism, storing options in a hash. | |
1579 | ||
1580 | To obtain this, a reference to a hash must be passed I<as the first | |
1581 | argument> to GetOptions(). For each option that is specified on the | |
1582 | command line, the option value will be stored in the hash with the | |
1583 | option name as key. Options that are not actually used on the command | |
1584 | line will not be put in the hash, on other words, | |
1585 | C<exists($h{option})> (or defined()) can be used to test if an option | |
1586 | was used. The drawback is that warnings will be issued if the program | |
1587 | runs under C<use strict> and uses C<$h{option}> without testing with | |
1588 | exists() or defined() first. | |
1589 | ||
1590 | my %h = (); | |
1591 | GetOptions (\%h, 'length=i'); # will store in $h{length} | |
1592 | ||
1593 | For options that take list or hash values, it is necessary to indicate | |
1594 | this by appending an C<@> or C<%> sign after the type: | |
1595 | ||
1596 | GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}} | |
1597 | ||
1598 | To make things more complicated, the hash may contain references to | |
1599 | the actual destinations, for example: | |
1600 | ||
1601 | my $len = 0; | |
1602 | my %h = ('length' => \$len); | |
1603 | GetOptions (\%h, 'length=i'); # will store in $len | |
1604 | ||
1605 | This example is fully equivalent with: | |
1606 | ||
1607 | my $len = 0; | |
1608 | GetOptions ('length=i' => \$len); # will store in $len | |
1609 | ||
1610 | Any mixture is possible. For example, the most frequently used options | |
1611 | could be stored in variables while all other options get stored in the | |
1612 | hash: | |
1613 | ||
1614 | my $verbose = 0; # frequently referred | |
1615 | my $debug = 0; # frequently referred | |
1616 | my %h = ('verbose' => \$verbose, 'debug' => \$debug); | |
1617 | GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i'); | |
1618 | if ( $verbose ) { ... } | |
1619 | if ( exists $h{filter} ) { ... option 'filter' was specified ... } | |
1620 | ||
1621 | =head2 Bundling | |
1622 | ||
1623 | With bundling it is possible to set several single-character options | |
1624 | at once. For example if C<a>, C<v> and C<x> are all valid options, | |
1625 | ||
1626 | -vax | |
1627 | ||
1628 | would set all three. | |
1629 | ||
1630 | Getopt::Long supports two levels of bundling. To enable bundling, a | |
1631 | call to Getopt::Long::Configure is required. | |
1632 | ||
1633 | The first level of bundling can be enabled with: | |
1634 | ||
1635 | Getopt::Long::Configure ("bundling"); | |
1636 | ||
1637 | Configured this way, single-character options can be bundled but long | |
1638 | options B<must> always start with a double dash C<--> to avoid | |
1639 | abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid | |
1640 | options, | |
1641 | ||
1642 | -vax | |
1643 | ||
1644 | would set C<a>, C<v> and C<x>, but | |
1645 | ||
1646 | --vax | |
1647 | ||
1648 | would set C<vax>. | |
1649 | ||
1650 | The second level of bundling lifts this restriction. It can be enabled | |
1651 | with: | |
1652 | ||
1653 | Getopt::Long::Configure ("bundling_override"); | |
1654 | ||
1655 | Now, C<-vax> would set the option C<vax>. | |
1656 | ||
1657 | When any level of bundling is enabled, option values may be inserted | |
1658 | in the bundle. For example: | |
1659 | ||
1660 | -h24w80 | |
1661 | ||
1662 | is equivalent to | |
1663 | ||
1664 | -h 24 -w 80 | |
1665 | ||
1666 | When configured for bundling, single-character options are matched | |
1667 | case sensitive while long options are matched case insensitive. To | |
1668 | have the single-character options matched case insensitive as well, | |
1669 | use: | |
1670 | ||
1671 | Getopt::Long::Configure ("bundling", "ignorecase_always"); | |
1672 | ||
1673 | It goes without saying that bundling can be quite confusing. | |
1674 | ||
1675 | =head2 The lonesome dash | |
1676 | ||
1677 | Normally, a lone dash C<-> on the command line will not be considered | |
1678 | an option. Option processing will terminate (unless "permute" is | |
1679 | configured) and the dash will be left in C<@ARGV>. | |
1680 | ||
1681 | It is possible to get special treatment for a lone dash. This can be | |
1682 | achieved by adding an option specification with an empty name, for | |
1683 | example: | |
1684 | ||
1685 | GetOptions ('' => \$stdio); | |
1686 | ||
1687 | A lone dash on the command line will now be a legal option, and using | |
1688 | it will set variable C<$stdio>. | |
1689 | ||
1690 | =head2 Argument callback | |
1691 | ||
1692 | A special option 'name' C<<>> can be used to designate a subroutine | |
1693 | to handle non-option arguments. When GetOptions() encounters an | |
1694 | argument that does not look like an option, it will immediately call this | |
1695 | subroutine and passes it one parameter: the argument name. | |
1696 | ||
1697 | For example: | |
1698 | ||
1699 | my $width = 80; | |
1700 | sub process { ... } | |
1701 | GetOptions ('width=i' => \$width, '<>' => \&process); | |
1702 | ||
1703 | When applied to the following command line: | |
1704 | ||
1705 | arg1 --width=72 arg2 --width=60 arg3 | |
1706 | ||
1707 | This will call | |
1708 | C<process("arg1")> while C<$width> is C<80>, | |
1709 | C<process("arg2")> while C<$width> is C<72>, and | |
1710 | C<process("arg3")> while C<$width> is C<60>. | |
1711 | ||
1712 | This feature requires configuration option B<permute>, see section | |
1713 | L<Configuring Getopt::Long>. | |
1714 | ||
1715 | ||
1716 | =head1 Configuring Getopt::Long | |
1717 | ||
1718 | Getopt::Long can be configured by calling subroutine | |
1719 | Getopt::Long::Configure(). This subroutine takes a list of quoted | |
1720 | strings, each specifying a configuration option to be enabled, e.g. | |
1721 | C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not | |
1722 | matter. Multiple calls to Configure() are possible. | |
1723 | ||
1724 | Alternatively, as of version 2.24, the configuration options may be | |
1725 | passed together with the C<use> statement: | |
1726 | ||
1727 | use Getopt::Long qw(:config no_ignore_case bundling); | |
1728 | ||
1729 | The following options are available: | |
1730 | ||
1731 | =over 12 | |
1732 | ||
1733 | =item default | |
1734 | ||
1735 | This option causes all configuration options to be reset to their | |
1736 | default values. | |
1737 | ||
1738 | =item posix_default | |
1739 | ||
1740 | This option causes all configuration options to be reset to their | |
1741 | default values as if the environment variable POSIXLY_CORRECT had | |
1742 | been set. | |
1743 | ||
1744 | =item auto_abbrev | |
1745 | ||
1746 | Allow option names to be abbreviated to uniqueness. | |
1747 | Default is enabled unless environment variable | |
1748 | POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled. | |
1749 | ||
1750 | =item getopt_compat | |
1751 | ||
1752 | Allow C<+> to start options. | |
1753 | Default is enabled unless environment variable | |
1754 | POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled. | |
1755 | ||
1756 | =item gnu_compat | |
1757 | ||
1758 | C<gnu_compat> controls whether C<--opt=> is allowed, and what it should | |
1759 | do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>, | |
1760 | C<--opt=> will give option C<opt> and empty value. | |
1761 | This is the way GNU getopt_long() does it. | |
1762 | ||
1763 | =item gnu_getopt | |
1764 | ||
1765 | This is a short way of setting C<gnu_compat> C<bundling> C<permute> | |
1766 | C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be | |
1767 | fully compatible with GNU getopt_long(). | |
1768 | ||
1769 | =item require_order | |
1770 | ||
1771 | Whether command line arguments are allowed to be mixed with options. | |
1772 | Default is disabled unless environment variable | |
1773 | POSIXLY_CORRECT has been set, in which case C<require_order> is enabled. | |
1774 | ||
1775 | See also C<permute>, which is the opposite of C<require_order>. | |
1776 | ||
1777 | =item permute | |
1778 | ||
1779 | Whether command line arguments are allowed to be mixed with options. | |
1780 | Default is enabled unless environment variable | |
1781 | POSIXLY_CORRECT has been set, in which case C<permute> is disabled. | |
1782 | Note that C<permute> is the opposite of C<require_order>. | |
1783 | ||
1784 | If C<permute> is enabled, this means that | |
1785 | ||
1786 | --foo arg1 --bar arg2 arg3 | |
1787 | ||
1788 | is equivalent to | |
1789 | ||
1790 | --foo --bar arg1 arg2 arg3 | |
1791 | ||
1792 | If an argument callback routine is specified, C<@ARGV> will always be | |
1793 | empty upon succesful return of GetOptions() since all options have been | |
1794 | processed. The only exception is when C<--> is used: | |
1795 | ||
1796 | --foo arg1 --bar arg2 -- arg3 | |
1797 | ||
1798 | This will call the callback routine for arg1 and arg2, and then | |
1799 | terminate GetOptions() leaving C<"arg2"> in C<@ARGV>. | |
1800 | ||
1801 | If C<require_order> is enabled, options processing | |
1802 | terminates when the first non-option is encountered. | |
1803 | ||
1804 | --foo arg1 --bar arg2 arg3 | |
1805 | ||
1806 | is equivalent to | |
1807 | ||
1808 | --foo -- arg1 --bar arg2 arg3 | |
1809 | ||
1810 | If C<pass_through> is also enabled, options processing will terminate | |
1811 | at the first unrecognized option, or non-option, whichever comes | |
1812 | first. | |
1813 | ||
1814 | =item bundling (default: disabled) | |
1815 | ||
1816 | Enabling this option will allow single-character options to be | |
1817 | bundled. To distinguish bundles from long option names, long options | |
1818 | I<must> be introduced with C<--> and bundles with C<->. | |
1819 | ||
1820 | Note that, if you have options C<a>, C<l> and C<all>, and | |
1821 | auto_abbrev enabled, possible arguments and option settings are: | |
1822 | ||
1823 | using argument sets option(s) | |
1824 | ------------------------------------------ | |
1825 | -a, --a a | |
1826 | -l, --l l | |
1827 | -al, -la, -ala, -all,... a, l | |
1828 | --al, --all all | |
1829 | ||
1830 | The suprising part is that C<--a> sets option C<a> (due to auto | |
1831 | completion), not C<all>. | |
1832 | ||
1833 | Note: disabling C<bundling> also disables C<bundling_override>. | |
1834 | ||
1835 | =item bundling_override (default: disabled) | |
1836 | ||
1837 | If C<bundling_override> is enabled, bundling is enabled as with | |
1838 | C<bundling> but now long option names override option bundles. | |
1839 | ||
1840 | Note: disabling C<bundling_override> also disables C<bundling>. | |
1841 | ||
1842 | B<Note:> Using option bundling can easily lead to unexpected results, | |
1843 | especially when mixing long options and bundles. Caveat emptor. | |
1844 | ||
1845 | =item ignore_case (default: enabled) | |
1846 | ||
1847 | If enabled, case is ignored when matching long option names. If, | |
1848 | however, bundling is enabled as well, single character options will be | |
1849 | treated case-sensitive. | |
1850 | ||
1851 | With C<ignore_case>, option specifications for options that only | |
1852 | differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as | |
1853 | duplicates. | |
1854 | ||
1855 | Note: disabling C<ignore_case> also disables C<ignore_case_always>. | |
1856 | ||
1857 | =item ignore_case_always (default: disabled) | |
1858 | ||
1859 | When bundling is in effect, case is ignored on single-character | |
1860 | options also. | |
1861 | ||
1862 | Note: disabling C<ignore_case_always> also disables C<ignore_case>. | |
1863 | ||
1864 | =item pass_through (default: disabled) | |
1865 | ||
1866 | Options that are unknown, ambiguous or supplied with an invalid option | |
1867 | value are passed through in C<@ARGV> instead of being flagged as | |
1868 | errors. This makes it possible to write wrapper scripts that process | |
1869 | only part of the user supplied command line arguments, and pass the | |
1870 | remaining options to some other program. | |
1871 | ||
1872 | If C<require_order> is enabled, options processing will terminate at | |
1873 | the first unrecognized option, or non-option, whichever comes first. | |
1874 | However, if C<permute> is enabled instead, results can become confusing. | |
1875 | ||
1876 | =item prefix | |
1877 | ||
1878 | The string that starts options. If a constant string is not | |
1879 | sufficient, see C<prefix_pattern>. | |
1880 | ||
1881 | =item prefix_pattern | |
1882 | ||
1883 | A Perl pattern that identifies the strings that introduce options. | |
1884 | Default is C<(--|-|\+)> unless environment variable | |
1885 | POSIXLY_CORRECT has been set, in which case it is C<(--|-)>. | |
1886 | ||
1887 | =item debug (default: disabled) | |
1888 | ||
1889 | Enable debugging output. | |
1890 | ||
1891 | =back | |
1892 | ||
1893 | =head1 Return values and Errors | |
1894 | ||
1895 | Configuration errors and errors in the option definitions are | |
1896 | signalled using die() and will terminate the calling program unless | |
1897 | the call to Getopt::Long::GetOptions() was embedded in C<eval { ... | |
1898 | }>, or die() was trapped using C<$SIG{__DIE__}>. | |
1899 | ||
1900 | GetOptions returns true to indicate success. | |
1901 | It returns false when the function detected one or more errors during | |
1902 | option parsing. These errors are signalled using warn() and can be | |
1903 | trapped with C<$SIG{__WARN__}>. | |
1904 | ||
1905 | Errors that can't happen are signalled using Carp::croak(). | |
1906 | ||
1907 | =head1 Legacy | |
1908 | ||
1909 | The earliest development of C<newgetopt.pl> started in 1990, with Perl | |
1910 | version 4. As a result, its development, and the development of | |
1911 | Getopt::Long, has gone through several stages. Since backward | |
1912 | compatibility has always been extremely important, the current version | |
1913 | of Getopt::Long still supports a lot of constructs that nowadays are | |
1914 | no longer necessary or otherwise unwanted. This section describes | |
1915 | briefly some of these 'features'. | |
1916 | ||
1917 | =head2 Default destinations | |
1918 | ||
1919 | When no destination is specified for an option, GetOptions will store | |
1920 | the resultant value in a global variable named C<opt_>I<XXX>, where | |
1921 | I<XXX> is the primary name of this option. When a progam executes | |
1922 | under C<use strict> (recommended), these variables must be | |
1923 | pre-declared with our() or C<use vars>. | |
1924 | ||
1925 | our $opt_length = 0; | |
1926 | GetOptions ('length=i'); # will store in $opt_length | |
1927 | ||
1928 | To yield a usable Perl variable, characters that are not part of the | |
1929 | syntax for variables are translated to underscores. For example, | |
1930 | C<--fpp-struct-return> will set the variable | |
1931 | C<$opt_fpp_struct_return>. Note that this variable resides in the | |
1932 | namespace of the calling program, not necessarily C<main>. For | |
1933 | example: | |
1934 | ||
1935 | GetOptions ("size=i", "sizes=i@"); | |
1936 | ||
1937 | with command line "-size 10 -sizes 24 -sizes 48" will perform the | |
1938 | equivalent of the assignments | |
1939 | ||
1940 | $opt_size = 10; | |
1941 | @opt_sizes = (24, 48); | |
1942 | ||
1943 | =head2 Alternative option starters | |
1944 | ||
1945 | A string of alternative option starter characters may be passed as the | |
1946 | first argument (or the first argument after a leading hash reference | |
1947 | argument). | |
1948 | ||
1949 | my $len = 0; | |
1950 | GetOptions ('/', 'length=i' => $len); | |
1951 | ||
1952 | Now the command line may look like: | |
1953 | ||
1954 | /length 24 -- arg | |
1955 | ||
1956 | Note that to terminate options processing still requires a double dash | |
1957 | C<-->. | |
1958 | ||
1959 | GetOptions() will not interpret a leading C<< "<>" >> as option starters | |
1960 | if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as | |
1961 | option starters, use C<< "><" >>. Confusing? Well, B<using a starter | |
1962 | argument is strongly deprecated> anyway. | |
1963 | ||
1964 | =head2 Configuration variables | |
1965 | ||
1966 | Previous versions of Getopt::Long used variables for the purpose of | |
1967 | configuring. Although manipulating these variables still work, it is | |
1968 | strongly encouraged to use the C<Configure> routine that was introduced | |
1969 | in version 2.17. Besides, it is much easier. | |
1970 | ||
1971 | =head1 Trouble Shooting | |
1972 | ||
1973 | =head2 Warning: Ignoring '!' modifier for short option | |
1974 | ||
1975 | This warning is issued when the '!' modifier is applied to a short | |
1976 | (one-character) option and bundling is in effect. E.g., | |
1977 | ||
1978 | Getopt::Long::Configure("bundling"); | |
1979 | GetOptions("foo|f!" => \$foo); | |
1980 | ||
1981 | Note that older Getopt::Long versions did not issue a warning, because | |
1982 | the '!' modifier was applied to the first name only. This bug was | |
1983 | fixed in 2.22. | |
1984 | ||
1985 | Solution: separate the long and short names and apply the '!' to the | |
1986 | long names only, e.g., | |
1987 | ||
1988 | GetOptions("foo!" => \$foo, "f" => \$foo); | |
1989 | ||
1990 | =head2 GetOptions does not return a false result when an option is not supplied | |
1991 | ||
1992 | That's why they're called 'options'. | |
1993 | ||
1994 | =head2 GetOptions does not split the command line correctly | |
1995 | ||
1996 | The command line is not split by GetOptions, but by the command line | |
1997 | interpreter (CLI). On Unix, this is the shell. On Windows, it is | |
1998 | COMMAND.COM or CMD.EXE. Other operating systems have other CLIs. | |
1999 | ||
2000 | It is important to know that these CLIs may behave different when the | |
2001 | command line contains special characters, in particular quotes or | |
2002 | backslashes. For example, with Unix shells you can use single quotes | |
2003 | (C<'>) and double quotes (C<">) to group words together. The following | |
2004 | alternatives are equivalent on Unix: | |
2005 | ||
2006 | "two words" | |
2007 | 'two words' | |
2008 | two\ words | |
2009 | ||
2010 | In case of doubt, insert the following statement in front of your Perl | |
2011 | program: | |
2012 | ||
2013 | print STDERR (join("|",@ARGV),"\n"); | |
2014 | ||
2015 | to verify how your CLI passes the arguments to the program. | |
2016 | ||
2017 | =head2 How do I put a "-?" option into a Getopt::Long? | |
2018 | ||
2019 | You can only obtain this using an alias, and Getopt::Long of at least | |
2020 | version 2.13. | |
2021 | ||
2022 | use Getopt::Long; | |
2023 | GetOptions ("help|?"); # -help and -? will both set $opt_help | |
2024 | ||
2025 | =head1 AUTHOR | |
2026 | ||
2027 | Johan Vromans <jvromans@squirrel.nl> | |
2028 | ||
2029 | =head1 COPYRIGHT AND DISCLAIMER | |
2030 | ||
2031 | This program is Copyright 2002,1990 by Johan Vromans. | |
2032 | This program is free software; you can redistribute it and/or | |
2033 | modify it under the terms of the Perl Artistic License or the | |
2034 | GNU General Public License as published by the Free Software | |
2035 | Foundation; either version 2 of the License, or (at your option) any | |
2036 | later version. | |
2037 | ||
2038 | This program is distributed in the hope that it will be useful, | |
2039 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
2040 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
2041 | GNU General Public License for more details. | |
2042 | ||
2043 | If you do not have a copy of the GNU General Public License write to | |
2044 | the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, | |
2045 | MA 02139, USA. | |
2046 | ||
2047 | =cut | |
2048 |