This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update to Term::ANSIColor 1.03, from Russ Allbery.
[perl5.git] / lib / Getopt / Long.pm
CommitLineData
a11f5414 1# GetOpt::Long.pm -- Universal options parsing
404cbe93 2
a11f5414
JV
3package Getopt::Long;
4
265c41c2 5# RCS Status : $Id: GetoptLong.pl,v 2.24 2000-03-14 21:28:52+01 jv Exp $
404cbe93
PP
6# Author : Johan Vromans
7# Created On : Tue Sep 11 15:00:12 1990
8# Last Modified By: Johan Vromans
265c41c2
GS
9# Last Modified On: Tue Mar 14 21:28:40 2000
10# Update Count : 721
404cbe93
PP
11# Status : Released
12
bb40d378 13################ Copyright ################
f06db76b 14
0b7031a2 15# This program is Copyright 1990,2000 by Johan Vromans.
bb40d378 16# This program is free software; you can redistribute it and/or
1a505819
GS
17# modify it under the terms of the Perl Artistic License or the
18# GNU General Public License as published by the Free Software
19# Foundation; either version 2 of the License, or (at your option) any
20# later version.
21#
bb40d378
JV
22# This program is distributed in the hope that it will be useful,
23# but WITHOUT ANY WARRANTY; without even the implied warranty of
24# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25# GNU General Public License for more details.
0b7031a2 26#
bb40d378 27# If you do not have a copy of the GNU General Public License write to
0b7031a2 28# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
f9a400e4 29# MA 02139, USA.
f06db76b 30
bb40d378 31################ Module Preamble ################
404cbe93 32
bb40d378 33use strict;
404cbe93 34
bb40d378 35BEGIN {
3a0431da 36 require 5.004;
bb40d378 37 use Exporter ();
e6d5c530 38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
bee0ef1e 39 $VERSION = "2.23";
e6d5c530
JV
40
41 @ISA = qw(Exporter);
42 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
43 %EXPORT_TAGS = qw();
44 @EXPORT_OK = qw();
45 use AutoLoader qw(AUTOLOAD);
bb40d378 46}
404cbe93 47
bb40d378 48# User visible variables.
e6d5c530 49use vars @EXPORT, @EXPORT_OK;
bb40d378
JV
50use vars qw($error $debug $major_version $minor_version);
51# Deprecated visible variables.
52use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
53 $passthrough);
e6d5c530 54# Official invisible variables.
0b7031a2 55use vars qw($genprefix $caller);
e6d5c530 56
0b7031a2 57# Public subroutines.
e6d5c530
JV
58sub Configure (@);
59sub config (@); # deprecated name
60sub GetOptions;
61
0b7031a2 62# Private subroutines.
e6d5c530
JV
63sub ConfigDefaults ();
64sub FindOption ($$$$$$$);
65sub Croak (@); # demand loading the real Croak
404cbe93 66
bb40d378 67################ Local Variables ################
404cbe93 68
e6d5c530
JV
69################ Resident subroutines ################
70
71sub ConfigDefaults () {
72 # Handle POSIX compliancy.
73 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
74 $genprefix = "(--|-)";
75 $autoabbrev = 0; # no automatic abbrev of options
76 $bundling = 0; # no bundling of single letter switches
77 $getopt_compat = 0; # disallow '+' to start options
78 $order = $REQUIRE_ORDER;
79 }
80 else {
81 $genprefix = "(--|-|\\+)";
82 $autoabbrev = 1; # automatic abbrev of options
83 $bundling = 0; # bundling off by default
84 $getopt_compat = 1; # allow '+' to start options
85 $order = $PERMUTE;
86 }
87 # Other configurable settings.
88 $debug = 0; # for debugging
89 $error = 0; # error tally
90 $ignorecase = 1; # ignore case when matching options
91 $passthrough = 0; # leave unrecognized options alone
92}
93
94################ Initialization ################
95
96# Values for $order. See GNU getopt.c for details.
97($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
98# Version major/minor numbers.
99($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
100
0b7031a2
GS
101ConfigDefaults();
102
e6d5c530
JV
103################ Package return ################
104
1051;
106
107__END__
108
109################ AutoLoading subroutines ################
110
bee0ef1e 111# RCS Status : $Id: GetoptLongAl.pl,v 2.27 2000-03-17 09:07:26+01 jv Exp $
e6d5c530
JV
112# Author : Johan Vromans
113# Created On : Fri Mar 27 11:50:30 1998
114# Last Modified By: Johan Vromans
bee0ef1e
GS
115# Last Modified On: Fri Mar 17 09:00:09 2000
116# Update Count : 55
e6d5c530 117# Status : Released
404cbe93 118
bb40d378 119sub GetOptions {
404cbe93 120
bb40d378 121 my @optionlist = @_; # local copy of the option descriptions
e6d5c530
JV
122 my $argend = '--'; # option list terminator
123 my %opctl = (); # table of arg.specs (long and abbrevs)
124 my %bopctl = (); # table of arg.specs (bundles)
0b7031a2 125 my $pkg = $caller || (caller)[0]; # current context
bb40d378 126 # Needed if linkage is omitted.
e6d5c530 127 my %aliases= (); # alias table
bb40d378
JV
128 my @ret = (); # accum for non-options
129 my %linkage; # linkage
130 my $userlinkage; # user supplied HASH
e6d5c530
JV
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
JV
137 print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
138 "called from package \"$pkg\".",
139 "\n ",
bee0ef1e 140 'GetOptionsAl $Revision: 2.27 $ ',
e6d5c530
JV
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
0b7031a2 155 # Check for ref HASH as first argument.
bb40d378 156 # First argument may be an object. It's OK to use this as long
0b7031a2 157 # as it is really a hash underneath.
bb40d378
JV
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
JV
165 # See if the first element of the optionlist contains option
166 # starter characters.
1a505819
GS
167 # Be careful not to interpret '<>' as option starters.
168 if ( $optionlist[0] =~ /^\W+$/
169 && !($optionlist[0] eq '<>'
170 && @optionlist > 0
171 && ref($optionlist[1])) ) {
bb40d378
JV
172 $genprefix = shift (@optionlist);
173 # Turn into regexp. Needs to be parenthesized!
174 $genprefix =~ s/(\W)/\\$1/g;
175 $genprefix = "([" . $genprefix . "])";
176 }
404cbe93 177
bb40d378
JV
178 # Verify correctness of optionlist.
179 %opctl = ();
180 %bopctl = ();
181 while ( @optionlist > 0 ) {
182 my $opt = shift (@optionlist);
404cbe93 183
bb40d378 184 # Strip leading prefix so people can specify "--foo=i" if they like.
3a0431da 185 $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
404cbe93 186
bb40d378
JV
187 if ( $opt eq '<>' ) {
188 if ( (defined $userlinkage)
189 && !(@optionlist > 0 && ref($optionlist[0]))
190 && (exists $userlinkage->{$opt})
191 && ref($userlinkage->{$opt}) ) {
192 unshift (@optionlist, $userlinkage->{$opt});
193 }
0b7031a2 194 unless ( @optionlist > 0
bb40d378
JV
195 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
196 $error .= "Option spec <> requires a reference to a subroutine\n";
197 next;
198 }
199 $linkage{'<>'} = shift (@optionlist);
200 next;
201 }
404cbe93 202
bb40d378 203 # Match option spec. Allow '?' as an alias.
e6d5c530 204 if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
bb40d378
JV
205 $error .= "Error in option spec: \"$opt\"\n";
206 next;
207 }
208 my ($o, $c, $a) = ($1, $5);
209 $c = '' unless defined $c;
404cbe93 210
bb40d378
JV
211 if ( ! defined $o ) {
212 # empty -> '-' option
213 $opctl{$o = ''} = $c;
214 }
215 else {
216 # Handle alias names
217 my @o = split (/\|/, $o);
218 my $linko = $o = $o[0];
219 # Force an alias if the option name is not locase.
220 $a = $o unless $o eq lc($o);
221 $o = lc ($o)
0b7031a2 222 if $ignorecase > 1
bb40d378
JV
223 || ($ignorecase
224 && ($bundling ? length($o) > 1 : 1));
404cbe93 225
bb40d378
JV
226 foreach ( @o ) {
227 if ( $bundling && length($_) == 1 ) {
228 $_ = lc ($_) if $ignorecase > 1;
229 if ( $c eq '!' ) {
230 $opctl{"no$_"} = $c;
231 warn ("Ignoring '!' modifier for short option $_\n");
265c41c2
GS
232 $opctl{$_} = $bopctl{$_} = '';
233 }
234 else {
235 $opctl{$_} = $bopctl{$_} = $c;
bb40d378 236 }
bb40d378
JV
237 }
238 else {
239 $_ = lc ($_) if $ignorecase;
240 if ( $c eq '!' ) {
241 $opctl{"no$_"} = $c;
265c41c2
GS
242 $opctl{$_} = ''
243 }
244 else {
245 $opctl{$_} = $c;
bb40d378 246 }
bb40d378
JV
247 }
248 if ( defined $a ) {
249 # Note alias.
250 $aliases{$_} = $a;
251 }
252 else {
253 # Set primary name.
254 $a = $_;
255 }
256 }
257 $o = $linko;
258 }
404cbe93 259
bb40d378
JV
260 # If no linkage is supplied in the @optionlist, copy it from
261 # the userlinkage if available.
262 if ( defined $userlinkage ) {
263 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
264 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
265 print STDERR ("=> found userlinkage for \"$o\": ",
266 "$userlinkage->{$o}\n")
267 if $debug;
268 unshift (@optionlist, $userlinkage->{$o});
269 }
270 else {
271 # Do nothing. Being undefined will be handled later.
272 next;
273 }
274 }
275 }
404cbe93 276
bb40d378
JV
277 # Copy the linkage. If omitted, link to global variable.
278 if ( @optionlist > 0 && ref($optionlist[0]) ) {
279 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
280 if $debug;
281 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
282 $linkage{$o} = shift (@optionlist);
283 }
284 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
285 $linkage{$o} = shift (@optionlist);
286 $opctl{$o} .= '@'
287 if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
288 $bopctl{$o} .= '@'
0b7031a2 289 if $bundling and defined $bopctl{$o} and
bb40d378
JV
290 $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
291 }
292 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
293 $linkage{$o} = shift (@optionlist);
294 $opctl{$o} .= '%'
295 if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
296 $bopctl{$o} .= '%'
0b7031a2 297 if $bundling and defined $bopctl{$o} and
bb40d378
JV
298 $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
299 }
300 else {
301 $error .= "Invalid option linkage for \"$opt\"\n";
302 }
303 }
304 else {
305 # Link to global $opt_XXX variable.
306 # Make sure a valid perl identifier results.
307 my $ov = $o;
308 $ov =~ s/\W/_/g;
309 if ( $c =~ /@/ ) {
310 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
311 if $debug;
312 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
313 }
314 elsif ( $c =~ /%/ ) {
315 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
316 if $debug;
317 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
318 }
319 else {
320 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
321 if $debug;
322 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
323 }
324 }
325 }
326
327 # Bail out if errors found.
328 die ($error) if $error;
329 $error = 0;
330
331 # Sort the possible long option names.
332 @opctl = sort(keys (%opctl)) if $autoabbrev;
333
334 # Show the options tables if debugging.
335 if ( $debug ) {
336 my ($arrow, $k, $v);
337 $arrow = "=> ";
338 while ( ($k,$v) = each(%opctl) ) {
339 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
340 $arrow = " ";
341 }
342 $arrow = "=> ";
343 while ( ($k,$v) = each(%bopctl) ) {
344 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
345 $arrow = " ";
346 }
347 }
348
349 # Process argument list
0b7031a2
GS
350 my $goon = 1;
351 while ( $goon && @ARGV > 0 ) {
bb40d378
JV
352
353 #### Get next argument ####
354
355 $opt = shift (@ARGV);
bb40d378
JV
356 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
357
358 #### Determine what we have ####
359
360 # Double dash is option list terminator.
361 if ( $opt eq $argend ) {
362 # Finish. Push back accumulated arguments and return.
0b7031a2 363 unshift (@ARGV, @ret)
bb40d378
JV
364 if $order == $PERMUTE;
365 return ($error == 0);
366 }
367
368 my $tryopt = $opt;
e6d5c530
JV
369 my $found; # success status
370 my $dsttype; # destination type ('@' or '%')
0b7031a2 371 my $incr; # destination increment
e6d5c530
JV
372 my $key; # key (if hash type)
373 my $arg; # option argument
374
0b7031a2
GS
375 ($found, $opt, $arg, $dsttype, $incr, $key) =
376 FindOption ($genprefix, $argend, $opt,
e6d5c530 377 \%opctl, \%bopctl, \@opctl, \%aliases);
bb40d378 378
e6d5c530 379 if ( $found ) {
0b7031a2 380
e6d5c530 381 # FindOption undefines $opt in case of errors.
bb40d378
JV
382 next unless defined $opt;
383
384 if ( defined $arg ) {
385 $opt = $aliases{$opt} if defined $aliases{$opt};
386
387 if ( defined $linkage{$opt} ) {
388 print STDERR ("=> ref(\$L{$opt}) -> ",
389 ref($linkage{$opt}), "\n") if $debug;
390
391 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
e6d5c530
JV
392 if ( $incr ) {
393 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
394 if $debug;
395 if ( defined ${$linkage{$opt}} ) {
396 ${$linkage{$opt}} += $arg;
397 }
398 else {
399 ${$linkage{$opt}} = $arg;
400 }
401 }
402 else {
403 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
404 if $debug;
405 ${$linkage{$opt}} = $arg;
406 }
bb40d378
JV
407 }
408 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
409 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
410 if $debug;
411 push (@{$linkage{$opt}}, $arg);
412 }
413 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
414 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
415 if $debug;
416 $linkage{$opt}->{$key} = $arg;
417 }
418 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
419 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
420 if $debug;
0b7031a2
GS
421 local ($@);
422 eval {
423 &{$linkage{$opt}}($opt, $arg);
424 };
425 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
bee0ef1e
GS
426 if ( $@ =~ /^!/ ) {
427 if ( $@ =~ /^!FINISH\b/ ) {
428 $goon = 0;
429 }
0b7031a2
GS
430 }
431 elsif ( $@ ne '' ) {
432 warn ($@);
433 $error++;
434 }
bb40d378
JV
435 }
436 else {
437 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
438 "\" in linkage\n");
e6d5c530 439 Croak ("Getopt::Long -- internal error!\n");
bb40d378
JV
440 }
441 }
442 # No entry in linkage means entry in userlinkage.
e6d5c530 443 elsif ( $dsttype eq '@' ) {
bb40d378
JV
444 if ( defined $userlinkage->{$opt} ) {
445 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
446 if $debug;
447 push (@{$userlinkage->{$opt}}, $arg);
448 }
449 else {
450 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
451 if $debug;
452 $userlinkage->{$opt} = [$arg];
453 }
454 }
e6d5c530 455 elsif ( $dsttype eq '%' ) {
bb40d378
JV
456 if ( defined $userlinkage->{$opt} ) {
457 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
458 if $debug;
459 $userlinkage->{$opt}->{$key} = $arg;
460 }
461 else {
462 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
463 if $debug;
464 $userlinkage->{$opt} = {$key => $arg};
465 }
466 }
467 else {
e6d5c530
JV
468 if ( $incr ) {
469 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
470 if $debug;
471 if ( defined $userlinkage->{$opt} ) {
472 $userlinkage->{$opt} += $arg;
473 }
474 else {
475 $userlinkage->{$opt} = $arg;
476 }
477 }
478 else {
479 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
480 $userlinkage->{$opt} = $arg;
481 }
bb40d378
JV
482 }
483 }
484 }
485
486 # Not an option. Save it if we $PERMUTE and don't have a <>.
487 elsif ( $order == $PERMUTE ) {
488 # Try non-options call-back.
489 my $cb;
490 if ( (defined ($cb = $linkage{'<>'})) ) {
0b7031a2
GS
491 local ($@);
492 eval {
493 &$cb ($tryopt);
494 };
495 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
bee0ef1e
GS
496 if ( $@ =~ /^!/ ) {
497 if ( $@ =~ /^!FINISH\b/ ) {
498 $goon = 0;
499 }
0b7031a2
GS
500 }
501 elsif ( $@ ne '' ) {
502 warn ($@);
503 $error++;
504 }
bb40d378
JV
505 }
506 else {
507 print STDERR ("=> saving \"$tryopt\" ",
508 "(not an option, may permute)\n") if $debug;
509 push (@ret, $tryopt);
510 }
511 next;
512 }
513
514 # ...otherwise, terminate.
515 else {
516 # Push this one back and exit.
517 unshift (@ARGV, $tryopt);
518 return ($error == 0);
519 }
520
521 }
522
523 # Finish.
524 if ( $order == $PERMUTE ) {
525 # Push back accumulated arguments
526 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
527 if $debug && @ret > 0;
528 unshift (@ARGV, @ret) if @ret > 0;
529 }
530
531 return ($error == 0);
532}
533
e6d5c530
JV
534# Option lookup.
535sub FindOption ($$$$$$$) {
bb40d378 536
e6d5c530
JV
537 # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
538 # returns (0) otherwise.
bb40d378 539
e6d5c530
JV
540 my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
541 my $key; # hash key for a hash option
542 my $arg;
bb40d378 543
e6d5c530 544 print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
bb40d378 545
e6d5c530 546 return (0) unless $opt =~ /^$prefix(.*)$/s;
bb40d378 547
3a0431da 548 $opt = $+;
bb40d378
JV
549 my ($starter) = $1;
550
551 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
552
553 my $optarg = undef; # value supplied with --opt=value
554 my $rest = undef; # remainder from unbundling
555
556 # If it is a long option, it may include the value.
557 if (($starter eq "--" || ($getopt_compat && !$bundling))
3a0431da 558 && $opt =~ /^([^=]+)=(.*)$/s ) {
bb40d378
JV
559 $opt = $1;
560 $optarg = $2;
0b7031a2 561 print STDERR ("=> option \"", $opt,
bb40d378
JV
562 "\", optarg = \"$optarg\"\n") if $debug;
563 }
564
565 #### Look it up ###
566
567 my $tryopt = $opt; # option to try
e6d5c530 568 my $optbl = $opctl; # table to look it up (long names)
bb40d378 569 my $type;
e6d5c530
JV
570 my $dsttype = '';
571 my $incr = 0;
bb40d378
JV
572
573 if ( $bundling && $starter eq '-' ) {
574 # Unbundle single letter option.
575 $rest = substr ($tryopt, 1);
576 $tryopt = substr ($tryopt, 0, 1);
577 $tryopt = lc ($tryopt) if $ignorecase > 1;
578 print STDERR ("=> $starter$tryopt unbundled from ",
579 "$starter$tryopt$rest\n") if $debug;
580 $rest = undef unless $rest ne '';
e6d5c530 581 $optbl = $bopctl; # look it up in the short names table
bb40d378
JV
582
583 # If bundling == 2, long options can override bundles.
584 if ( $bundling == 2 and
f9a400e4 585 defined ($rest) and
e6d5c530 586 defined ($type = $opctl->{$tryopt.$rest}) ) {
bb40d378
JV
587 print STDERR ("=> $starter$tryopt rebundled to ",
588 "$starter$tryopt$rest\n") if $debug;
589 $tryopt .= $rest;
590 undef $rest;
591 }
0b7031a2 592 }
bb40d378
JV
593
594 # Try auto-abbreviation.
595 elsif ( $autoabbrev ) {
596 # Downcase if allowed.
597 $tryopt = $opt = lc ($opt) if $ignorecase;
598 # Turn option name into pattern.
599 my $pat = quotemeta ($opt);
600 # Look up in option names.
e6d5c530 601 my @hits = grep (/^$pat/, @{$names});
bb40d378 602 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
e6d5c530 603 "out of ", scalar(@{$names}), "\n") if $debug;
bb40d378
JV
604
605 # Check for ambiguous results.
606 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
607 # See if all matches are for the same option.
608 my %hit;
609 foreach ( @hits ) {
e6d5c530 610 $_ = $aliases->{$_} if defined $aliases->{$_};
bb40d378
JV
611 $hit{$_} = 1;
612 }
613 # Now see if it really is ambiguous.
614 unless ( keys(%hit) == 1 ) {
e6d5c530 615 return (0) if $passthrough;
bb40d378
JV
616 warn ("Option ", $opt, " is ambiguous (",
617 join(", ", @hits), ")\n");
618 $error++;
619 undef $opt;
e6d5c530 620 return (1, $opt,$arg,$dsttype,$incr,$key);
bb40d378
JV
621 }
622 @hits = keys(%hit);
623 }
624
625 # Complete the option name, if appropriate.
626 if ( @hits == 1 && $hits[0] ne $opt ) {
627 $tryopt = $hits[0];
628 $tryopt = lc ($tryopt) if $ignorecase;
629 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
630 if $debug;
631 }
632 }
633
634 # Map to all lowercase if ignoring case.
635 elsif ( $ignorecase ) {
636 $tryopt = lc ($opt);
637 }
638
639 # Check validity by fetching the info.
640 $type = $optbl->{$tryopt} unless defined $type;
641 unless ( defined $type ) {
e6d5c530 642 return (0) if $passthrough;
bb40d378
JV
643 warn ("Unknown option: ", $opt, "\n");
644 $error++;
e6d5c530 645 return (1, $opt,$arg,$dsttype,$incr,$key);
bb40d378
JV
646 }
647 # Apparently valid.
648 $opt = $tryopt;
649 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
650
651 #### Determine argument status ####
652
653 # If it is an option w/o argument, we're almost finished with it.
e6d5c530 654 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
bb40d378 655 if ( defined $optarg ) {
e6d5c530 656 return (0) if $passthrough;
bb40d378
JV
657 warn ("Option ", $opt, " does not take an argument\n");
658 $error++;
659 undef $opt;
660 }
e6d5c530 661 elsif ( $type eq '' || $type eq '+' ) {
bb40d378 662 $arg = 1; # supply explicit value
e6d5c530 663 $incr = $type eq '+';
bb40d378
JV
664 }
665 else {
666 substr ($opt, 0, 2) = ''; # strip NO prefix
667 $arg = 0; # supply explicit value
668 }
669 unshift (@ARGV, $starter.$rest) if defined $rest;
e6d5c530 670 return (1, $opt,$arg,$dsttype,$incr,$key);
bb40d378
JV
671 }
672
673 # Get mandatory status and type info.
674 my $mand;
e6d5c530 675 ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
bb40d378
JV
676
677 # Check if there is an option argument available.
0b7031a2 678 if ( defined $optarg ? ($optarg eq '')
bb40d378
JV
679 : !(defined $rest || @ARGV > 0) ) {
680 # Complain if this option needs an argument.
681 if ( $mand eq "=" ) {
e6d5c530 682 return (0) if $passthrough;
bb40d378
JV
683 warn ("Option ", $opt, " requires an argument\n");
684 $error++;
685 undef $opt;
686 }
687 if ( $mand eq ":" ) {
688 $arg = $type eq "s" ? '' : 0;
689 }
e6d5c530 690 return (1, $opt,$arg,$dsttype,$incr,$key);
bb40d378
JV
691 }
692
693 # Get (possibly optional) argument.
694 $arg = (defined $rest ? $rest
695 : (defined $optarg ? $optarg : shift (@ARGV)));
696
697 # Get key if this is a "name=value" pair for a hash option.
698 $key = undef;
e6d5c530 699 if ($dsttype eq '%' && defined $arg) {
0b7031a2 700 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
bb40d378
JV
701 }
702
703 #### Check if the argument is valid for this option ####
704
705 if ( $type eq "s" ) { # string
0b7031a2 706 # A mandatory string takes anything.
e6d5c530 707 return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
bb40d378 708
0b7031a2
GS
709 # An optional string takes almost anything.
710 return (1, $opt,$arg,$dsttype,$incr,$key)
e6d5c530
JV
711 if defined $optarg || defined $rest;
712 return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
bb40d378
JV
713
714 # Check for option or option list terminator.
715 if ($arg eq $argend ||
e6d5c530 716 $arg =~ /^$prefix.+/) {
bb40d378
JV
717 # Push back.
718 unshift (@ARGV, $arg);
719 # Supply empty value.
720 $arg = '';
721 }
722 }
723
724 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
0b7031a2 725 if ( $bundling && defined $rest && $rest =~ /^([-+]?[0-9]+)(.*)$/s ) {
bb40d378
JV
726 $arg = $1;
727 $rest = $2;
728 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
729 }
0b7031a2 730 elsif ( $arg !~ /^[-+]?[0-9]+$/ ) {
bb40d378
JV
731 if ( defined $optarg || $mand eq "=" ) {
732 if ( $passthrough ) {
733 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
734 unless defined $optarg;
e6d5c530 735 return (0);
bb40d378
JV
736 }
737 warn ("Value \"", $arg, "\" invalid for option ",
738 $opt, " (number expected)\n");
739 $error++;
740 undef $opt;
741 # Push back.
742 unshift (@ARGV, $starter.$rest) if defined $rest;
743 }
744 else {
745 # Push back.
746 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
747 # Supply default value.
748 $arg = 0;
749 }
750 }
751 }
752
753 elsif ( $type eq "f" ) { # real number, int is also ok
754 # We require at least one digit before a point or 'e',
755 # and at least one digit following the point and 'e'.
756 # [-]NN[.NN][eNN]
757 if ( $bundling && defined $rest &&
0b7031a2 758 $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
bb40d378 759 $arg = $1;
3a0431da 760 $rest = $+;
bb40d378
JV
761 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
762 }
0b7031a2 763 elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
bb40d378
JV
764 if ( defined $optarg || $mand eq "=" ) {
765 if ( $passthrough ) {
766 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
767 unless defined $optarg;
e6d5c530 768 return (0);
bb40d378
JV
769 }
770 warn ("Value \"", $arg, "\" invalid for option ",
771 $opt, " (real number expected)\n");
772 $error++;
773 undef $opt;
774 # Push back.
775 unshift (@ARGV, $starter.$rest) if defined $rest;
776 }
777 else {
778 # Push back.
779 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
780 # Supply default value.
781 $arg = 0.0;
782 }
783 }
784 }
785 else {
e6d5c530 786 Croak ("GetOpt::Long internal error (Can't happen)\n");
bb40d378 787 }
e6d5c530
JV
788 return (1, $opt, $arg, $dsttype, $incr, $key);
789}
bb40d378 790
e6d5c530
JV
791# Getopt::Long Configuration.
792sub Configure (@) {
793 my (@options) = @_;
0b7031a2
GS
794
795 my $prevconfig =
796 [ $error, $debug, $major_version, $minor_version,
797 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
798 $passthrough, $genprefix ];
799
800 if ( ref($options[0]) eq 'ARRAY' ) {
801 ( $error, $debug, $major_version, $minor_version,
802 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
803 $passthrough, $genprefix ) = @{shift(@options)};
804 }
805
e6d5c530
JV
806 my $opt;
807 foreach $opt ( @options ) {
808 my $try = lc ($opt);
809 my $action = 1;
810 if ( $try =~ /^no_?(.*)$/s ) {
811 $action = 0;
812 $try = $+;
813 }
814 if ( $try eq 'default' or $try eq 'defaults' ) {
815 ConfigDefaults () if $action;
816 }
817 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
818 $autoabbrev = $action;
819 }
820 elsif ( $try eq 'getopt_compat' ) {
821 $getopt_compat = $action;
822 }
823 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
824 $ignorecase = $action;
825 }
826 elsif ( $try eq 'ignore_case_always' ) {
827 $ignorecase = $action ? 2 : 0;
828 }
829 elsif ( $try eq 'bundling' ) {
830 $bundling = $action;
831 }
832 elsif ( $try eq 'bundling_override' ) {
833 $bundling = $action ? 2 : 0;
834 }
835 elsif ( $try eq 'require_order' ) {
836 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
837 }
838 elsif ( $try eq 'permute' ) {
839 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
840 }
841 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
842 $passthrough = $action;
843 }
844 elsif ( $try =~ /^prefix=(.+)$/ ) {
845 $genprefix = $1;
846 # Turn into regexp. Needs to be parenthesized!
847 $genprefix = "(" . quotemeta($genprefix) . ")";
848 eval { '' =~ /$genprefix/; };
849 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
850 }
851 elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
852 $genprefix = $1;
853 # Parenthesize if needed.
0b7031a2 854 $genprefix = "(" . $genprefix . ")"
e6d5c530
JV
855 unless $genprefix =~ /^\(.*\)$/;
856 eval { '' =~ /$genprefix/; };
857 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
858 }
859 elsif ( $try eq 'debug' ) {
860 $debug = $action;
861 }
862 else {
863 Croak ("Getopt::Long: unknown config parameter \"$opt\"")
864 }
bb40d378 865 }
0b7031a2 866 $prevconfig;
e6d5c530 867}
bb40d378 868
e6d5c530
JV
869# Deprecated name.
870sub config (@) {
871 Configure (@_);
872}
bb40d378 873
e6d5c530
JV
874# To prevent Carp from being loaded unnecessarily.
875sub Croak (@) {
876 require 'Carp.pm';
877 $Carp::CarpLevel = 1;
878 Carp::croak(@_);
879};
bb40d378 880
e6d5c530 881################ Documentation ################
bb40d378
JV
882
883=head1 NAME
884
0b7031a2 885Getopt::Long - Extended processing of command line options
bb40d378
JV
886
887=head1 SYNOPSIS
888
889 use Getopt::Long;
890 $result = GetOptions (...option-descriptions...);
891
892=head1 DESCRIPTION
893
894The Getopt::Long module implements an extended getopt function called
895GetOptions(). This function adheres to the POSIX syntax for command
896line options, with GNU extensions. In general, this means that options
897have long names instead of single letters, and are introduced with a
898double dash "--". Support for bundling of command line options, as was
899the case with the more traditional single-letter approach, is provided
0b7031a2
GS
900but not enabled by default.
901
902=head1 Command Line Options, an Introduction
903
904Command line operated programs traditionally take their arguments from
905the command line, for example filenames or other information that the
906program needs to know. Besides arguments, these programs often take
907command line I<options> as well. Options are not necessary for the
908program to work, hence the name 'option', but are used to modify its
909default behaviour. For example, a program could do its job quietly,
910but with a suitable option it could provide verbose information about
911what it did.
912
913Command line options come in several flavours. Historically, they are
914preceded by a single dash C<->, and consist of a single letter.
915
916 -l -a -c
917
918Usually, these single-character options can be bundled:
919
920 -lac
921
922Options can have values, the value is placed after the option
923character. Sometimes with whitespace in between, sometimes not:
924
925 -s 24 -s24
926
927Due to the very cryptic nature of these options, another style was
928developed that used long names. So instead of a cryptic C<-l> one
929could use the more descriptive C<--long>. To distinguish between a
930bundle of single-character options and a long one, two dashes are used
931to precede the option name. Early implementations of long options used
932a plus C<+> instead. Also, option values could be specified either
933like
934
935 --size=24
936
937or
938
939 --size 24
940
941The C<+> form is now obsolete and strongly deprecated.
942
943=head1 Getting Started with Getopt::Long
944
945Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
946the firs Perl module that provided support for handling the new style
947of command line options, hence the name Getopt::Long. This module
948also supports single-character options and bundling. In this case, the
949options are restricted to alphabetic characters only, and the
950characters C<?> and C<->.
951
952To use Getopt::Long from a Perl program, you must include the
953following line in your Perl program:
954
955 use Getopt::Long;
956
957This will load the core of the Getopt::Long module and prepare your
958program for using it. Most of the actual Getopt::Long code is not
959loaded until you really call one of its functions.
960
961In the default configuration, options names may be abbreviated to
962uniqueness, case does not matter, and a single dash is sufficient,
963even for long option names. Also, options may be placed between
964non-option arguments. See L<Configuring Getopt::Long> for more
965details on how to configure Getopt::Long.
966
967=head2 Simple options
968
969The most simple options are the ones that take no values. Their mere
970presence on the command line enables the option. Popular examples are:
971
972 --all --verbose --quiet --debug
973
974Handling simple options is straightforward:
975
976 my $verbose = ''; # option variable with default value (false)
977 my $all = ''; # option variable with default value (false)
978 GetOptions ('verbose' => \$verbose, 'all' => \$all);
979
980The call to GetOptions() parses the command line arguments that are
981present in C<@ARGV> and sets the option variable to the value C<1> if
982the option did occur on the command line. Otherwise, the option
983variable is not touched. Setting the option value to true is often
984called I<enabling> the option.
985
986The option name as specified to the GetOptions() function is called
987the option I<specification>. Later we'll see that this specification
988can contain more than just the option name. The reference to the
989variable is called the option I<destination>.
990
991GetOptions() will return a true value if the command line could be
992processed successfully. Otherwise, it will write error messages to
993STDERR, and return a false result.
994
995=head2 A little bit less simple options
996
997Getopt::Long supports two useful variants of simple options:
998I<negatable> options and I<incremental> options.
999
1000A negatable option is specified with a exclamation mark C<!> after the
1001option name:
1002
1003 my $verbose = ''; # option variable with default value (false)
1004 GetOptions ('verbose!' => \$verbose);
1005
1006Now, using C<--verbose> on the command line will enable C<$verbose>,
1007as expected. But it is also allowed to use C<--noverbose>, which will
1008disable C<$verbose> by setting its value to C<0>. Using a suitable
1009default value, the program can find out whether C<$verbose> is false
1010by default, or disabled by using C<--noverbose>.
1011
1012An incremental option is specified with a plus C<+> after the
1013option name:
1014
1015 my $verbose = ''; # option variable with default value (false)
1016 GetOptions ('verbose+' => \$verbose);
1017
1018Using C<--verbose> on the command line will increment the value of
1019C<$verbose>. This way the program can keep track of how many times the
1020option occurred on the command line. For example, each occurrence of
1021C<--verbose> could increase the verbosity level of the program.
1022
1023=head2 Mixing command line option with other arguments
1024
1025Usually programs take command line options as well as other arguments,
1026for example, file names. It is good practice to always specify the
1027options first, and the other arguments last. Getopt::Long will,
1028however, allow the options and arguments to be mixed and 'filter out'
1029all the options before passing the rest of the arguments to the
1030program. To stop Getopt::Long from processing further arguments,
1031insert a double dash C<--> on the command line:
1032
1033 --size 24 -- --all
1034
1035In this example, C<--all> will I<not> be treated as an option, but
1036passed to the program unharmed, in C<@ARGV>.
1037
1038=head2 Options with values
1039
1040For options that take values it must be specified whether the option
1041value is required or not, and what kind of value the option expects.
1042
1043Three kinds of values are supported: integer numbers, floating point
1044numbers, and strings.
1045
1046If the option value is required, Getopt::Long will take the
1047command line argument that follows the option and assign this to the
1048option variable. If, however, the option value is specified as
1049optional, this will only be done if that value does not look like a
1050valid command line option itself.
bb40d378 1051
0b7031a2
GS
1052 my $tag = ''; # option variable with default value
1053 GetOptions ('tag=s' => \$tag);
bb40d378 1054
0b7031a2
GS
1055In the option specification, the option name is followed by an equals
1056sign C<=> and the letter C<s>. The equals sign indicates that this
1057option requires a value. The letter C<s> indicates that this value is
1058an arbitrary string. Other possible value types are C<i> for integer
1059values, and C<f> for floating point values. Using a colon C<:> instead
1060of the equals sign indicates that the option value is optional. In
1061this case, if no suitable value is supplied, string valued options get
1062an empty string C<''> assigned, while numeric options are set to C<0>.
bb40d378 1063
0b7031a2 1064=head2 Options with multiple values
bb40d378 1065
0b7031a2
GS
1066Options sometimes take several values. For example, a program could
1067use multiple directories to search for library files:
bb40d378 1068
0b7031a2 1069 --library lib/stdlib --library lib/extlib
bb40d378 1070
0b7031a2
GS
1071To accomplish this behaviour, simply specify an array reference as the
1072destination for the option:
bb40d378 1073
0b7031a2
GS
1074 my @libfiles = ();
1075 GetOptions ("library=s" => \@libfiles);
bb40d378 1076
0b7031a2
GS
1077Used with the example above, C<@libfiles> would contain two strings
1078upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
1079It is also possible to specify that only integer or floating point
1080numbers are acceptible values.
bb40d378 1081
0b7031a2
GS
1082Often it is useful to allow comma-separated lists of values as well as
1083multiple occurrences of the options. This is easy using Perl's split()
1084and join() operators:
bb40d378 1085
0b7031a2
GS
1086 my @libfiles = ();
1087 GetOptions ("library=s" => \@libfiles);
1088 @libfiles = split(/,/,join(',',@libfiles));
bb40d378 1089
0b7031a2
GS
1090Of course, it is important to choose the right separator string for
1091each purpose.
3cb6de81 1092
0b7031a2 1093=head2 Options with hash values
bb40d378 1094
0b7031a2
GS
1095If the option destination is a reference to a hash, the option will
1096take, as value, strings of the form I<key>C<=>I<value>. The value will
1097be stored with the specified key in the hash.
bb40d378 1098
0b7031a2
GS
1099 my %defines = ();
1100 GetOptions ("define=s" => \%defines);
bb40d378 1101
0b7031a2
GS
1102When used with command line options:
1103
1104 --define os=linux --define vendor=redhat
1105
1106the hash C<%defines> will contain two keys, C<"os"> with value
1107C<"linux> and C<"vendor"> with value C<"redhat">.
1108It is also possible to specify that only integer or floating point
1109numbers are acceptible values. The keys are always taken to be strings.
1110
1111=head2 User-defined subroutines to handle options
1112
1113Ultimate control over what should be done when (actually: each time)
1114an option is encountered on the command line can be achieved by
1115designating a reference to a subroutine (or an anonymous subroutine)
1116as the option destination. When GetOptions() encounters the option, it
1117will call the subroutine with two arguments: the name of the option,
1118and the value to be assigned. It is up to the subroutine to store the
1119value, or do whatever it thinks is appropriate.
1120
1121A trivial application of this mechanism is to implement options that
1122are related to each other. For example:
1123
1124 my $verbose = ''; # option variable with default value (false)
1125 GetOptions ('verbose' => \$verbose,
1126 'quiet' => sub { $verbose = 0 });
1127
1128Here C<--verbose> and C<--quiet> control the same variable
1129C<$verbose>, but with opposite values.
1130
1131If the subroutine needs to signal an error, it should call die() with
1132the desired error message as its argument. GetOptions() will catch the
1133die(), issue the error message, and record that an error result must
1134be returned upon completion.
1135
bee0ef1e
GS
1136If the text of the error message starts with an exclamantion mark C<!>
1137it is interpreted specially by GetOptions(). There is currently one
1138special command implemented: C<die("!FINISH")> will cause GetOptions()
1139to stop processing options, as if it encountered a double dash C<-->.
0b7031a2
GS
1140
1141=head2 Options with multiple names
1142
1143Often it is user friendly to supply alternate mnemonic names for
1144options. For example C<--height> could be an alternate name for
1145C<--length>. Alternate names can be included in the option
1146specification, separated by vertical bar C<|> characters. To implement
1147the above example:
1148
1149 GetOptions ('length|height=f' => \$length);
1150
1151The first name is called the I<primary> name, the other names are
1152called I<aliases>.
1153
1154Multiple alternate names are possible.
1155
1156=head2 Case and abbreviations
1157
1158Without additional configuration, GetOptions() will ignore the case of
1159option names, and allow the options to be abbreviated to uniqueness.
1160
1161 GetOptions ('length|height=f' => \$length, "head" => \$head);
1162
1163This call will allow C<--l> and C<--L> for the length option, but
1164requires a least C<--hea> and C<--hei> for the head and height options.
1165
1166=head2 Summary of Option Specifications
1167
1168Each option specifier consists of two parts: the name specification
1169and the argument specification.
1170
1171The name specification contains the name of the option, optionally
1172followed by a list of alternative names separated by vertical bar
1173characters.
1174
1175 length option name is "length"
1176 length|size|l name is "length", aliases are "size" and "l"
1177
1178The argument specification is optional. If omitted, the option is
1179considered boolean, a value of 1 will be assigned when the option is
1180used on the command line.
1181
1182The argument specification can be
1183
1184=over
bb40d378
JV
1185
1186=item !
1187
0b7031a2
GS
1188The option does not take an argument and may be negated, i.e. prefixed
1189by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
265c41c2
GS
1190assigned) and C<--nofoo> (a value of 0 will be assigned). If the
1191option has aliases, this applies to the aliases as well.
1192
1193Using negation on a single letter option when bundling is in effect is
1194pointless and will result in a warning.
bb40d378 1195
e6d5c530
JV
1196=item +
1197
0b7031a2
GS
1198The option does not take an argument and will be incremented by 1
1199every time it appears on the command line. E.g. C<"more+">, when used
1200with C<--more --more --more>, will increment the value three times,
1201resulting in a value of 3 (provided it was 0 or undefined at first).
e6d5c530 1202
0b7031a2 1203The C<+> specifier is ignored if the option destination is not a scalar.
e6d5c530 1204
0b7031a2 1205=item = I<type> [ I<desttype> ]
bb40d378 1206
0b7031a2
GS
1207The option requires an argument of the given type. Supported types
1208are:
bb40d378 1209
0b7031a2 1210=over
bb40d378 1211
0b7031a2 1212=item s
bb40d378 1213
0b7031a2
GS
1214String. An arbitrary sequence of characters. It is valid for the
1215argument to start with C<-> or C<-->.
bb40d378 1216
0b7031a2 1217=item i
bb40d378 1218
0b7031a2
GS
1219Integer. An optional leading plus or minus sign, followed by a
1220sequence of digits.
bb40d378 1221
0b7031a2 1222=item f
bb40d378 1223
0b7031a2 1224Real number. For example C<3.14>, C<-6.23E24> and so on.
bb40d378 1225
0b7031a2
GS
1226=back
1227
1228The I<desttype> can be C<@> or C<%> to specify that the option is
1229list or a hash valued. This is only needed when the destination for
1230the option value is not otherwise specified. It should be omitted when
1231not needed.
1232
1233=item : I<type> [ I<desttype> ]
404cbe93 1234
0b7031a2
GS
1235Like C<=>, but designates the argument as optional.
1236If omitted, an empty string will be assigned to string values options,
1237and the value zero to numeric options.
404cbe93 1238
0b7031a2
GS
1239Note that if a string argument starts with C<-> or C<-->, it will be
1240considered an option on itself.
404cbe93
PP
1241
1242=back
1243
0b7031a2 1244=head1 Advanced Possibilities
404cbe93 1245
0b7031a2 1246=head2 Documentation and help texts
404cbe93 1247
0b7031a2
GS
1248Getopt::Long encourages the use of Pod::Usage to produce help
1249messages. For example:
404cbe93 1250
0b7031a2
GS
1251 use Getopt::Long;
1252 use Pod::Usage;
404cbe93 1253
0b7031a2
GS
1254 my $man = 0;
1255 my $help = 0;
404cbe93 1256
0b7031a2
GS
1257 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1258 pod2usage(1) if $help;
1259 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
404cbe93 1260
0b7031a2 1261 __END__
404cbe93 1262
0b7031a2 1263 =head1 NAME
404cbe93 1264
0b7031a2 1265 sample - Using GetOpt::Long and Pod::Usage
404cbe93 1266
0b7031a2 1267 =head1 SYNOPSIS
404cbe93 1268
0b7031a2 1269 sample [options] [file ...]
404cbe93 1270
0b7031a2
GS
1271 Options:
1272 -help brief help message
1273 -man full documentation
381319f7 1274
0b7031a2 1275 =head1 OPTIONS
381319f7 1276
0b7031a2 1277 =over 8
381319f7 1278
0b7031a2 1279 =item B<-help>
381319f7 1280
0b7031a2 1281 Print a brief help message and exits.
404cbe93 1282
0b7031a2 1283 =item B<-man>
404cbe93 1284
0b7031a2 1285 Prints the manual page and exits.
404cbe93 1286
0b7031a2 1287 =back
404cbe93 1288
0b7031a2 1289 =head1 DESCRIPTION
404cbe93 1290
0b7031a2
GS
1291 B<This program> will read the given input file(s) and do someting
1292 useful with the contents thereof.
404cbe93 1293
0b7031a2 1294 =cut
535b5725 1295
0b7031a2 1296See L<Pod::Usage> for details.
535b5725 1297
0b7031a2 1298=head2 Storing options in a hash
404cbe93 1299
0b7031a2
GS
1300Sometimes, for example when there are a lot of options, having a
1301separate variable for each of them can be cumbersome. GetOptions()
1302supports, as an alternative mechanism, storing options in a hash.
404cbe93 1303
0b7031a2
GS
1304To obtain this, a reference to a hash must be passed I<as the first
1305argument> to GetOptions(). For each option that is specified on the
1306command line, the option value will be stored in the hash with the
1307option name as key. Options that are not actually used on the command
1308line will not be put in the hash, on other words,
1309C<exists($h{option})> (or defined()) can be used to test if an option
1310was used. The drawback is that warnings will be issued if the program
1311runs under C<use strict> and uses C<$h{option}> without testing with
1312exists() or defined() first.
381319f7 1313
0b7031a2
GS
1314 my %h = ();
1315 GetOptions (\%h, 'length=i'); # will store in $h{length}
f06db76b 1316
0b7031a2
GS
1317For options that take list or hash values, it is necessary to indicate
1318this by appending an C<@> or C<%> sign after the type:
f06db76b 1319
0b7031a2 1320 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
f06db76b 1321
0b7031a2
GS
1322To make things more complicated, the hash may contain references to
1323the actual destinations, for example:
f06db76b 1324
0b7031a2
GS
1325 my $len = 0;
1326 my %h = ('length' => \$len);
1327 GetOptions (\%h, 'length=i'); # will store in $len
f06db76b 1328
0b7031a2 1329This example is fully equivalent with:
a11f5414 1330
0b7031a2
GS
1331 my $len = 0;
1332 GetOptions ('length=i' => \$len); # will store in $len
f06db76b 1333
0b7031a2
GS
1334Any mixture is possible. For example, the most frequently used options
1335could be stored in variables while all other options get stored in the
1336hash:
f06db76b 1337
0b7031a2
GS
1338 my $verbose = 0; # frequently referred
1339 my $debug = 0; # frequently referred
1340 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1341 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1342 if ( $verbose ) { ... }
1343 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
f06db76b 1344
0b7031a2 1345=head2 Bundling
f06db76b 1346
0b7031a2
GS
1347With bundling it is possible to set several single-character options
1348at once. For example if C<a>, C<v> and C<x> are all valid options,
bb40d378 1349
0b7031a2 1350 -vax
bb40d378 1351
0b7031a2 1352would set all three.
f06db76b 1353
0b7031a2
GS
1354Getopt::Long supports two levels of bundling. To enable bundling, a
1355call to Getopt::Long::Configure is required.
bb40d378 1356
0b7031a2 1357The first level of bundling can be enabled with:
f06db76b 1358
0b7031a2 1359 Getopt::Long::Configure ("bundling");
404cbe93 1360
0b7031a2
GS
1361Configured this way, single-character options can be bundled but long
1362options B<must> always start with a double dash C<--> to avoid
1363abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1364options,
404cbe93 1365
0b7031a2 1366 -vax
381319f7 1367
0b7031a2 1368would set C<a>, C<v> and C<x>, but
404cbe93 1369
0b7031a2 1370 --vax
404cbe93 1371
0b7031a2 1372would set C<vax>.
a11f5414 1373
0b7031a2
GS
1374The second level of bundling lifts this restriction. It can be enabled
1375with:
a11f5414 1376
0b7031a2 1377 Getopt::Long::Configure ("bundling_override");
a11f5414 1378
0b7031a2 1379Now, C<-vax> would set the option C<vax>.
a11f5414 1380
0b7031a2
GS
1381When any level of bundling is enabled, option values may be inserted
1382in the bundle. For example:
381319f7 1383
0b7031a2 1384 -h24w80
f06db76b 1385
0b7031a2 1386is equivalent to
f06db76b 1387
0b7031a2 1388 -h 24 -w 80
f06db76b 1389
0b7031a2
GS
1390When configured for bundling, single-character options are matched
1391case sensitive while long options are matched case insensitive. To
1392have the single-character options matched case insensitive as well,
1393use:
a0d0e21e 1394
0b7031a2 1395 Getopt::Long::Configure ("bundling", "ignorecase_always");
a0d0e21e 1396
0b7031a2 1397It goes without saying that bundling can be quite confusing.
404cbe93 1398
0b7031a2 1399=head2 The lonesome dash
404cbe93 1400
0b7031a2
GS
1401Some applications require the option C<-> (that's a lone dash). This
1402can be achieved by adding an option specification with an empty name:
a0d0e21e 1403
0b7031a2 1404 GetOptions ('' => \$stdio);
a11f5414 1405
0b7031a2
GS
1406A lone dash on the command line will now be legal, and set options
1407variable C<$stdio>.
a0d0e21e 1408
0b7031a2 1409=head2 Argument call-back
a0d0e21e 1410
0b7031a2
GS
1411A special option 'name' C<<>> can be used to designate a subroutine
1412to handle non-option arguments. When GetOptions() encounters an
1413argument that does not look like an option, it will immediately call this
1414subroutine and passes it the argument as a parameter.
a0d0e21e 1415
0b7031a2 1416For example:
a0d0e21e 1417
0b7031a2
GS
1418 my $width = 80;
1419 sub process { ... }
1420 GetOptions ('width=i' => \$width, '<>' => \&process);
a0d0e21e 1421
0b7031a2 1422When applied to the following command line:
a11f5414 1423
0b7031a2 1424 arg1 --width=72 arg2 --width=60 arg3
404cbe93 1425
0b7031a2
GS
1426This will call
1427C<process("arg1")> while C<$width> is C<80>,
1428C<process("arg2")> while C<$width> is C<72>, and
1429C<process("arg3")> while C<$width> is C<60>.
381319f7 1430
0b7031a2
GS
1431This feature requires configuration option B<permute>, see section
1432L<Configuring Getopt::Long>.
a0d0e21e 1433
a0d0e21e 1434
0b7031a2
GS
1435=head1 Configuring Getopt::Long
1436
1437Getopt::Long can be configured by calling subroutine
1438Getopt::Long::Configure(). This subroutine takes a list of quoted
1439strings, each specifying a configuration option to be set, e.g.
1440C<ignore_case>, or reset, e.g. C<no_ignore_case>. Case does not
1441matter. Multiple calls to Configure() are possible.
404cbe93 1442
bb40d378 1443The following options are available:
404cbe93 1444
bb40d378 1445=over 12
a0d0e21e 1446
bb40d378 1447=item default
a0d0e21e 1448
bb40d378
JV
1449This option causes all configuration options to be reset to their
1450default values.
404cbe93 1451
bb40d378 1452=item auto_abbrev
404cbe93 1453
bb40d378
JV
1454Allow option names to be abbreviated to uniqueness.
1455Default is set unless environment variable
0b7031a2 1456POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is reset.
404cbe93 1457
0b7031a2 1458=item getopt_compat
a0d0e21e 1459
0b7031a2 1460Allow C<+> to start options.
bb40d378 1461Default is set unless environment variable
0b7031a2 1462POSIXLY_CORRECT has been set, in which case C<getopt_compat> is reset.
88e49c4e 1463
bb40d378 1464=item require_order
404cbe93 1465
0b7031a2 1466Whether command line arguments are allowed to be mixed with options.
bb40d378 1467Default is set unless environment variable
0b7031a2 1468POSIXLY_CORRECT has been set, in which case C<require_order> is reset.
404cbe93 1469
0b7031a2 1470See also C<permute>, which is the opposite of C<require_order>.
a0d0e21e 1471
bb40d378 1472=item permute
404cbe93 1473
0b7031a2 1474Whether command line arguments are allowed to be mixed with options.
bb40d378 1475Default is set unless environment variable
0b7031a2
GS
1476POSIXLY_CORRECT has been set, in which case C<permute> is reset.
1477Note that C<permute> is the opposite of C<require_order>.
a0d0e21e 1478
0b7031a2 1479If C<permute> is set, this means that
a0d0e21e 1480
0b7031a2 1481 --foo arg1 --bar arg2 arg3
a0d0e21e 1482
bb40d378 1483is equivalent to
a0d0e21e 1484
0b7031a2 1485 --foo --bar arg1 arg2 arg3
a0d0e21e 1486
0b7031a2
GS
1487If an argument call-back routine is specified, C<@ARGV> will always be
1488empty upon succesful return of GetOptions() since all options have been
1489processed. The only exception is when C<--> is used:
a0d0e21e 1490
0b7031a2 1491 --foo arg1 --bar arg2 -- arg3
404cbe93 1492
bb40d378 1493will call the call-back routine for arg1 and arg2, and terminate
0b7031a2 1494GetOptions() leaving C<"arg2"> in C<@ARGV>.
381319f7 1495
0b7031a2 1496If C<require_order> is set, options processing
bb40d378 1497terminates when the first non-option is encountered.
a0d0e21e 1498
0b7031a2 1499 --foo arg1 --bar arg2 arg3
381319f7 1500
bb40d378 1501is equivalent to
381319f7 1502
0b7031a2 1503 --foo -- arg1 --bar arg2 arg3
404cbe93 1504
bb40d378 1505=item bundling (default: reset)
404cbe93 1506
0b7031a2
GS
1507Setting this option will allow single-character options to be bundled.
1508To distinguish bundles from long option names, long options I<must> be
1509introduced with C<--> and single-character options (and bundles) with
1510C<->.
bb40d378 1511
0b7031a2 1512Note: resetting C<bundling> also resets C<bundling_override>.
a11f5414 1513
bb40d378 1514=item bundling_override (default: reset)
381319f7 1515
0b7031a2
GS
1516If C<bundling_override> is set, bundling is enabled as with
1517C<bundling> but now long option names override option bundles.
381319f7 1518
0b7031a2 1519Note: resetting C<bundling_override> also resets C<bundling>.
381319f7 1520
bb40d378
JV
1521B<Note:> Using option bundling can easily lead to unexpected results,
1522especially when mixing long options and bundles. Caveat emptor.
381319f7 1523
bb40d378 1524=item ignore_case (default: set)
381319f7 1525
0b7031a2
GS
1526If set, case is ignored when matching long option names. Single
1527character options will be treated case-sensitive.
381319f7 1528
0b7031a2 1529Note: resetting C<ignore_case> also resets C<ignore_case_always>.
381319f7 1530
bb40d378 1531=item ignore_case_always (default: reset)
a11f5414 1532
bb40d378
JV
1533When bundling is in effect, case is ignored on single-character
1534options also.
381319f7 1535
0b7031a2 1536Note: resetting C<ignore_case_always> also resets C<ignore_case>.
381319f7 1537
bb40d378 1538=item pass_through (default: reset)
a0d0e21e 1539
0b7031a2
GS
1540Options that are unknown, ambiguous or supplied with an invalid option
1541value are passed through in C<@ARGV> instead of being flagged as
1542errors. This makes it possible to write wrapper scripts that process
1543only part of the user supplied command line arguments, and pass the
bb40d378 1544remaining options to some other program.
a0d0e21e 1545
0b7031a2 1546This can be very confusing, especially when C<permute> is also set.
16c18a90 1547
3a0431da
JV
1548=item prefix
1549
0b7031a2
GS
1550The string that starts options. If a constant string is not
1551sufficient, see C<prefix_pattern>.
3a0431da
JV
1552
1553=item prefix_pattern
1554
1555A Perl pattern that identifies the strings that introduce options.
1556Default is C<(--|-|\+)> unless environment variable
1557POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1558
bb40d378 1559=item debug (default: reset)
a0d0e21e 1560
bb40d378 1561Enable copious debugging output.
a0d0e21e 1562
bb40d378 1563=back
a0d0e21e 1564
0b7031a2 1565=head1 Return values and Errors
381319f7 1566
0b7031a2
GS
1567Configuration errors and errors in the option definitions are
1568signalled using die() and will terminate the calling program unless
1569the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
1570}>, or die() was trapped using C<$SIG{__DIE__}>.
a0d0e21e 1571
0b7031a2 1572A return value of 1 (true) indicates success.
a0d0e21e 1573
0b7031a2
GS
1574A return status of 0 (false) indicates that the function detected one
1575or more errors during option parsing. These errors are signalled using
1576warn() and can be trapped with C<$SIG{__WARN__}>.
a0d0e21e 1577
0b7031a2 1578Errors that can't happen are signalled using Carp::croak().
a0d0e21e 1579
0b7031a2 1580=head1 Legacy
a0d0e21e 1581
0b7031a2
GS
1582The earliest development of C<newgetopt.pl> started in 1990, with Perl
1583version 4. As a result, its development, and the development of
1584Getopt::Long, has gone through several stages. Since backward
1585compatibility has always been extremely important, the current version
1586of Getopt::Long still supports a lot of constructs that nowadays are
1587no longer necessary or otherwise unwanted. This section describes
1588briefly some of these 'features'.
a0d0e21e 1589
0b7031a2 1590=head2 Default destinations
a0d0e21e 1591
0b7031a2
GS
1592When no destination is specified for an option, GetOptions will store
1593the resultant value in a global variable named C<opt_>I<XXX>, where
1594I<XXX> is the primary name of this option. When a progam executes
1595under C<use strict> (recommended), these variables must be
1596pre-declared with our() or C<use vars>.
1597
1598 our $opt_length = 0;
1599 GetOptions ('length=i'); # will store in $opt_length
1600
1601To yield a usable Perl variable, characters that are not part of the
1602syntax for variables are translated to underscores. For example,
1603C<--fpp-struct-return> will set the variable
1604C<$opt_fpp_struct_return>. Note that this variable resides in the
1605namespace of the calling program, not necessarily C<main>. For
1606example:
1607
1608 GetOptions ("size=i", "sizes=i@");
1609
1610with command line "-size 10 -sizes 24 -sizes 48" will perform the
1611equivalent of the assignments
1612
1613 $opt_size = 10;
1614 @opt_sizes = (24, 48);
1615
1616=head2 Alternative option starters
1617
1618A string of alternative option starter characters may be passed as the
1619first argument (or the first argument after a leading hash reference
1620argument).
1621
1622 my $len = 0;
1623 GetOptions ('/', 'length=i' => $len);
1624
1625Now the command line may look like:
1626
1627 /length 24 -- arg
1628
1629Note that to terminate options processing still requires a double dash
1630C<-->.
1631
1632GetOptions() will not interpret a leading C<"<>"> as option starters
1633if the next argument is a reference. To force C<"<"> and C<">"> as
1634option starters, use C<"><">. Confusing? Well, B<using a starter
1635argument is strongly deprecated> anyway.
1636
1637=head2 Configuration variables
1638
1639Previous versions of Getopt::Long used variables for the purpose of
1640configuring. Although manipulating these variables still work, it
1641is strongly encouraged to use the new C<config> routine. Besides, it
1642is much easier.
a0d0e21e 1643
bb40d378 1644=head1 AUTHOR
a11f5414 1645
bb40d378 1646Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
a11f5414 1647
bb40d378 1648=head1 COPYRIGHT AND DISCLAIMER
a11f5414 1649
0b7031a2 1650This program is Copyright 2000,1990 by Johan Vromans.
bb40d378 1651This program is free software; you can redistribute it and/or
1a505819
GS
1652modify it under the terms of the Perl Artistic License or the
1653GNU General Public License as published by the Free Software
1654Foundation; either version 2 of the License, or (at your option) any
1655later version.
a11f5414 1656
bb40d378
JV
1657This program is distributed in the hope that it will be useful,
1658but WITHOUT ANY WARRANTY; without even the implied warranty of
1659MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1660GNU General Public License for more details.
a0d0e21e 1661
bb40d378 1662If you do not have a copy of the GNU General Public License write to
f9a400e4
JH
1663the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
1664MA 02139, USA.
a0d0e21e 1665
bb40d378 1666=cut
0b7031a2
GS
1667
1668# Local Variables:
1669# mode: perl
1670# eval: (load-file "pod.el")
1671# End: