This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Getopt-Long to CPAN version 2.42
[perl5.git] / cpan / Getopt-Long / lib / Getopt / Long.pm
CommitLineData
cdac3961 1#! perl
a11f5414 2
cdac3961 3# Getopt::Long.pm -- Universal options parsing
404cbe93
PP
4# Author : Johan Vromans
5# Created On : Tue Sep 11 15:00:12 1990
6# Last Modified By: Johan Vromans
7867c822
CBW
7# Last Modified On: Tue Oct 1 08:25:52 2013
8# Update Count : 1651
404cbe93
PP
9# Status : Released
10
bb40d378 11################ Module Preamble ################
404cbe93 12
cdac3961
CBW
13package Getopt::Long;
14
76744544
JH
15use 5.004;
16
bb40d378 17use strict;
404cbe93 18
2d08fc49 19use vars qw($VERSION);
7867c822 20$VERSION = 2.42;
7d1b667f 21# For testing versions only.
cdac3961 22use vars qw($VERSION_STRING);
7867c822 23$VERSION_STRING = "2.42";
e6d5c530 24
76744544 25use Exporter;
10933be5 26use vars qw(@ISA @EXPORT @EXPORT_OK);
76744544 27@ISA = qw(Exporter);
10933be5
RGS
28
29# Exported subroutines.
30sub GetOptions(@); # always
a19443d4
RGS
31sub GetOptionsFromArray(@); # on demand
32sub GetOptionsFromString(@); # on demand
10933be5
RGS
33sub Configure(@); # on demand
34sub HelpMessage(@); # on demand
35sub VersionMessage(@); # in demand
36
76744544
JH
37BEGIN {
38 # Init immediately so their contents can be used in the 'use vars' below.
10933be5 39 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
8de02997
RGS
40 @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
41 &GetOptionsFromArray &GetOptionsFromString);
bb40d378 42}
404cbe93 43
bb40d378 44# User visible variables.
e6d5c530 45use vars @EXPORT, @EXPORT_OK;
bb40d378
JV
46use vars qw($error $debug $major_version $minor_version);
47# Deprecated visible variables.
48use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
49 $passthrough);
e6d5c530 50# Official invisible variables.
554627f6 51use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
e6d5c530 52
0b7031a2 53# Public subroutines.
10933be5 54sub config(@); # deprecated name
e6d5c530 55
0b7031a2 56# Private subroutines.
10933be5
RGS
57sub ConfigDefaults();
58sub ParseOptionSpec($$);
59sub OptCtl($);
8de02997 60sub FindOption($$$$$);
d4ad7505 61sub ValidValue ($$$$$);
404cbe93 62
bb40d378 63################ Local Variables ################
404cbe93 64
10933be5
RGS
65# $requested_version holds the version that was mentioned in the 'use'
66# or 'require', if any. It can be used to enable or disable specific
67# features.
68my $requested_version = 0;
69
e6d5c530
JV
70################ Resident subroutines ################
71
10933be5 72sub ConfigDefaults() {
e6d5c530
JV
73 # Handle POSIX compliancy.
74 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
75 $genprefix = "(--|-)";
76 $autoabbrev = 0; # no automatic abbrev of options
77 $bundling = 0; # no bundling of single letter switches
78 $getopt_compat = 0; # disallow '+' to start options
79 $order = $REQUIRE_ORDER;
80 }
81 else {
82 $genprefix = "(--|-|\\+)";
83 $autoabbrev = 1; # automatic abbrev of options
84 $bundling = 0; # bundling off by default
85 $getopt_compat = 1; # allow '+' to start options
86 $order = $PERMUTE;
87 }
88 # Other configurable settings.
89 $debug = 0; # for debugging
90 $error = 0; # error tally
91 $ignorecase = 1; # ignore case when matching options
92 $passthrough = 0; # leave unrecognized options alone
10e5c9cc 93 $gnu_compat = 0; # require --opt=val if value is optional
554627f6 94 $longprefix = "(--)"; # what does a long prefix look like
10e5c9cc
JH
95}
96
97# Override import.
98sub import {
99 my $pkg = shift; # package
100 my @syms = (); # symbols to import
101 my @config = (); # configuration
102 my $dest = \@syms; # symbols first
103 for ( @_ ) {
104 if ( $_ eq ':config' ) {
105 $dest = \@config; # config next
106 next;
107 }
10933be5 108 push(@$dest, $_); # push
10e5c9cc
JH
109 }
110 # Hide one level and call super.
111 local $Exporter::ExportLevel = 1;
10933be5 112 push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
cdac3961 113 $requested_version = 0;
10e5c9cc
JH
114 $pkg->SUPER::import(@syms);
115 # And configure.
10933be5 116 Configure(@config) if @config;
e6d5c530
JV
117}
118
119################ Initialization ################
120
121# Values for $order. See GNU getopt.c for details.
122($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
123# Version major/minor numbers.
124($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
125
0b7031a2
GS
126ConfigDefaults();
127
10e5c9cc
JH
128################ OO Interface ################
129
130package Getopt::Long::Parser;
131
10e5c9cc
JH
132# Store a copy of the default configuration. Since ConfigDefaults has
133# just been called, what we get from Configure is the default.
134my $default_config = do {
10e5c9cc
JH
135 Getopt::Long::Configure ()
136};
137
138sub new {
139 my $that = shift;
140 my $class = ref($that) || $that;
141 my %atts = @_;
142
143 # Register the callers package.
ea071ac9 144 my $self = { caller_pkg => (caller)[0] };
10e5c9cc
JH
145
146 bless ($self, $class);
147
148 # Process config attributes.
149 if ( defined $atts{config} ) {
10e5c9cc
JH
150 my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
151 $self->{settings} = Getopt::Long::Configure ($save);
152 delete ($atts{config});
153 }
154 # Else use default config.
155 else {
156 $self->{settings} = $default_config;
157 }
158
159 if ( %atts ) { # Oops
eab822e5
JH
160 die(__PACKAGE__.": unhandled attributes: ".
161 join(" ", sort(keys(%atts)))."\n");
10e5c9cc
JH
162 }
163
164 $self;
165}
166
167sub configure {
168 my ($self) = shift;
169
10e5c9cc
JH
170 # Restore settings, merge new settings in.
171 my $save = Getopt::Long::Configure ($self->{settings}, @_);
172
173 # Restore orig config and save the new config.
0d617128 174 $self->{settings} = Getopt::Long::Configure ($save);
10e5c9cc
JH
175}
176
177sub getoptions {
178 my ($self) = shift;
179
cdac3961
CBW
180 return $self->getoptionsfromarray(\@ARGV, @_);
181}
182
183sub getoptionsfromarray {
184 my ($self) = shift;
185
10e5c9cc
JH
186 # Restore config settings.
187 my $save = Getopt::Long::Configure ($self->{settings});
188
189 # Call main routine.
190 my $ret = 0;
ea071ac9 191 $Getopt::Long::caller = $self->{caller_pkg};
2d08fc49
JH
192
193 eval {
194 # Locally set exception handler to default, otherwise it will
195 # be called implicitly here, and again explicitly when we try
196 # to deliver the messages.
a19443d4 197 local ($SIG{__DIE__}) = 'DEFAULT';
cdac3961 198 $ret = Getopt::Long::GetOptionsFromArray (@_);
2d08fc49 199 };
10e5c9cc
JH
200
201 # Restore saved settings.
202 Getopt::Long::Configure ($save);
203
204 # Handle errors and return value.
205 die ($@) if $@;
206 return $ret;
207}
208
209package Getopt::Long;
210
10933be5
RGS
211################ Back to Normal ################
212
2d08fc49 213# Indices in option control info.
bd444ebb
JH
214# Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
215use constant CTL_TYPE => 0;
2d08fc49
JH
216#use constant CTL_TYPE_FLAG => '';
217#use constant CTL_TYPE_NEG => '!';
218#use constant CTL_TYPE_INCR => '+';
219#use constant CTL_TYPE_INT => 'i';
bd444ebb 220#use constant CTL_TYPE_INTINC => 'I';
2d08fc49
JH
221#use constant CTL_TYPE_XINT => 'o';
222#use constant CTL_TYPE_FLOAT => 'f';
223#use constant CTL_TYPE_STRING => 's';
e6d5c530 224
bd444ebb 225use constant CTL_CNAME => 1;
e6d5c530 226
d4ad7505 227use constant CTL_DEFAULT => 2;
bd444ebb
JH
228
229use constant CTL_DEST => 3;
2d08fc49
JH
230 use constant CTL_DEST_SCALAR => 0;
231 use constant CTL_DEST_ARRAY => 1;
232 use constant CTL_DEST_HASH => 2;
233 use constant CTL_DEST_CODE => 3;
e6d5c530 234
d4ad7505
RGS
235use constant CTL_AMIN => 4;
236use constant CTL_AMAX => 5;
7d1b667f 237
bd444ebb
JH
238# FFU.
239#use constant CTL_RANGE => ;
240#use constant CTL_REPEAT => ;
404cbe93 241
8de02997
RGS
242# Rather liberal patterns to match numbers.
243use constant PAT_INT => "[-+]?_*[0-9][0-9_]*";
244use constant PAT_XINT =>
245 "(?:".
246 "[-+]?_*[1-9][0-9_]*".
247 "|".
248 "0x_*[0-9a-f][0-9a-f_]*".
249 "|".
250 "0b_*[01][01_]*".
251 "|".
252 "0[0-7_]*".
253 ")";
7867c822 254use constant PAT_FLOAT => "[-+]?[0-9_]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
8de02997 255
10933be5 256sub GetOptions(@) {
8de02997
RGS
257 # Shift in default array.
258 unshift(@_, \@ARGV);
cdac3961 259 # Try to keep caller() and Carp consistent.
8de02997
RGS
260 goto &GetOptionsFromArray;
261}
262
a19443d4 263sub GetOptionsFromString(@) {
8de02997
RGS
264 my ($string) = shift;
265 require Text::ParseWords;
266 my $args = [ Text::ParseWords::shellwords($string) ];
267 $caller ||= (caller)[0]; # current context
268 my $ret = GetOptionsFromArray($args, @_);
269 return ( $ret, $args ) if wantarray;
270 if ( @$args ) {
271 $ret = 0;
272 warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
273 }
274 $ret;
275}
404cbe93 276
a19443d4 277sub GetOptionsFromArray(@) {
8de02997
RGS
278
279 my ($argv, @optionlist) = @_; # local copy of the option descriptions
e6d5c530 280 my $argend = '--'; # option list terminator
2d08fc49 281 my %opctl = (); # table of option specs
0b7031a2 282 my $pkg = $caller || (caller)[0]; # current context
bb40d378 283 # Needed if linkage is omitted.
bb40d378
JV
284 my @ret = (); # accum for non-options
285 my %linkage; # linkage
286 my $userlinkage; # user supplied HASH
e6d5c530 287 my $opt; # current option
2d08fc49 288 my $prefix = $genprefix; # current prefix
e6d5c530 289
bb40d378 290 $error = '';
404cbe93 291
9e01bed8
JH
292 if ( $debug ) {
293 # Avoid some warnings if debugging.
294 local ($^W) = 0;
295 print STDERR
cdac3961 296 ("Getopt::Long $Getopt::Long::VERSION ",
9e01bed8
JH
297 "called from package \"$pkg\".",
298 "\n ",
8de02997 299 "argv: (@$argv)",
9e01bed8
JH
300 "\n ",
301 "autoabbrev=$autoabbrev,".
302 "bundling=$bundling,",
303 "getopt_compat=$getopt_compat,",
304 "gnu_compat=$gnu_compat,",
305 "order=$order,",
306 "\n ",
307 "ignorecase=$ignorecase,",
308 "requested_version=$requested_version,",
309 "passthrough=$passthrough,",
554627f6
RGS
310 "genprefix=\"$genprefix\",",
311 "longprefix=\"$longprefix\".",
9e01bed8
JH
312 "\n");
313 }
404cbe93 314
0b7031a2 315 # Check for ref HASH as first argument.
bb40d378 316 # First argument may be an object. It's OK to use this as long
0b7031a2 317 # as it is really a hash underneath.
bb40d378 318 $userlinkage = undef;
7d1b667f 319 if ( @optionlist && ref($optionlist[0]) and
0613d572 320 UNIVERSAL::isa($optionlist[0],'HASH') ) {
bb40d378
JV
321 $userlinkage = shift (@optionlist);
322 print STDERR ("=> user linkage: $userlinkage\n") if $debug;
323 }
404cbe93 324
bb40d378
JV
325 # See if the first element of the optionlist contains option
326 # starter characters.
1a505819 327 # Be careful not to interpret '<>' as option starters.
7d1b667f 328 if ( @optionlist && $optionlist[0] =~ /^\W+$/
1a505819
GS
329 && !($optionlist[0] eq '<>'
330 && @optionlist > 0
331 && ref($optionlist[1])) ) {
2d08fc49 332 $prefix = shift (@optionlist);
bb40d378 333 # Turn into regexp. Needs to be parenthesized!
2d08fc49
JH
334 $prefix =~ s/(\W)/\\$1/g;
335 $prefix = "([" . $prefix . "])";
336 print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
bb40d378 337 }
404cbe93 338
bb40d378
JV
339 # Verify correctness of optionlist.
340 %opctl = ();
7d1b667f 341 while ( @optionlist ) {
bb40d378 342 my $opt = shift (@optionlist);
404cbe93 343
0613d572
SP
344 unless ( defined($opt) ) {
345 $error .= "Undefined argument in option spec\n";
346 next;
347 }
348
bb40d378 349 # Strip leading prefix so people can specify "--foo=i" if they like.
2d08fc49 350 $opt = $+ if $opt =~ /^$prefix+(.*)$/s;
404cbe93 351
bb40d378
JV
352 if ( $opt eq '<>' ) {
353 if ( (defined $userlinkage)
354 && !(@optionlist > 0 && ref($optionlist[0]))
355 && (exists $userlinkage->{$opt})
356 && ref($userlinkage->{$opt}) ) {
357 unshift (@optionlist, $userlinkage->{$opt});
358 }
0b7031a2 359 unless ( @optionlist > 0
bb40d378
JV
360 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
361 $error .= "Option spec <> requires a reference to a subroutine\n";
bd444ebb
JH
362 # Kill the linkage (to avoid another error).
363 shift (@optionlist)
364 if @optionlist && ref($optionlist[0]);
bb40d378
JV
365 next;
366 }
367 $linkage{'<>'} = shift (@optionlist);
368 next;
369 }
404cbe93 370
2d08fc49
JH
371 # Parse option spec.
372 my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
373 unless ( defined $name ) {
374 # Failed. $orig contains the error message. Sorry for the abuse.
375 $error .= $orig;
bd444ebb
JH
376 # Kill the linkage (to avoid another error).
377 shift (@optionlist)
378 if @optionlist && ref($optionlist[0]);
bb40d378
JV
379 next;
380 }
404cbe93 381
bb40d378
JV
382 # If no linkage is supplied in the @optionlist, copy it from
383 # the userlinkage if available.
384 if ( defined $userlinkage ) {
385 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
2d08fc49
JH
386 if ( exists $userlinkage->{$orig} &&
387 ref($userlinkage->{$orig}) ) {
388 print STDERR ("=> found userlinkage for \"$orig\": ",
389 "$userlinkage->{$orig}\n")
bb40d378 390 if $debug;
2d08fc49 391 unshift (@optionlist, $userlinkage->{$orig});
bb40d378
JV
392 }
393 else {
394 # Do nothing. Being undefined will be handled later.
395 next;
396 }
397 }
398 }
404cbe93 399
bb40d378
JV
400 # Copy the linkage. If omitted, link to global variable.
401 if ( @optionlist > 0 && ref($optionlist[0]) ) {
2d08fc49 402 print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
bb40d378 403 if $debug;
2d08fc49
JH
404 my $rl = ref($linkage{$orig} = shift (@optionlist));
405
406 if ( $rl eq "ARRAY" ) {
407 $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
bb40d378 408 }
2d08fc49
JH
409 elsif ( $rl eq "HASH" ) {
410 $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
bb40d378 411 }
8de02997 412 elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
9e01bed8
JH
413# if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
414# my $t = $linkage{$orig};
415# $$t = $linkage{$orig} = [];
416# }
417# elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
418# }
419# else {
420 # Ok.
421# }
422 }
423 elsif ( $rl eq "CODE" ) {
2d08fc49 424 # Ok.
bb40d378
JV
425 }
426 else {
427 $error .= "Invalid option linkage for \"$opt\"\n";
428 }
429 }
430 else {
431 # Link to global $opt_XXX variable.
432 # Make sure a valid perl identifier results.
2d08fc49 433 my $ov = $orig;
bb40d378 434 $ov =~ s/\W/_/g;
2d08fc49
JH
435 if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
436 print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
bb40d378 437 if $debug;
2d08fc49 438 eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
bb40d378 439 }
2d08fc49
JH
440 elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
441 print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
bb40d378 442 if $debug;
2d08fc49 443 eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
bb40d378
JV
444 }
445 else {
2d08fc49 446 print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
bb40d378 447 if $debug;
2d08fc49 448 eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
bb40d378
JV
449 }
450 }
a19443d4
RGS
451
452 if ( $opctl{$name}[CTL_TYPE] eq 'I'
453 && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
454 || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
455 ) {
456 $error .= "Invalid option linkage for \"$opt\"\n";
457 }
458
bb40d378
JV
459 }
460
461 # Bail out if errors found.
462 die ($error) if $error;
463 $error = 0;
464
10933be5
RGS
465 # Supply --version and --help support, if needed and allowed.
466 if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
467 if ( !defined($opctl{version}) ) {
468 $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
469 $linkage{version} = \&VersionMessage;
470 }
9e01bed8 471 $auto_version = 1;
10933be5
RGS
472 }
473 if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
474 if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
475 $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
476 $linkage{help} = \&HelpMessage;
477 }
9e01bed8 478 $auto_help = 1;
10933be5
RGS
479 }
480
bb40d378
JV
481 # Show the options tables if debugging.
482 if ( $debug ) {
483 my ($arrow, $k, $v);
484 $arrow = "=> ";
485 while ( ($k,$v) = each(%opctl) ) {
2d08fc49 486 print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
bb40d378
JV
487 $arrow = " ";
488 }
489 }
490
491 # Process argument list
0b7031a2 492 my $goon = 1;
8de02997 493 while ( $goon && @$argv > 0 ) {
bb40d378 494
2d08fc49 495 # Get next argument.
8de02997 496 $opt = shift (@$argv);
2d08fc49 497 print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
bb40d378
JV
498
499 # Double dash is option list terminator.
cdac3961 500 if ( defined($opt) && $opt eq $argend ) {
10933be5
RGS
501 push (@ret, $argend) if $passthrough;
502 last;
503 }
bb40d378 504
2d08fc49 505 # Look it up.
bb40d378 506 my $tryopt = $opt;
e6d5c530 507 my $found; # success status
e6d5c530
JV
508 my $key; # key (if hash type)
509 my $arg; # option argument
2d08fc49 510 my $ctl; # the opctl entry
e6d5c530 511
2d08fc49 512 ($found, $opt, $ctl, $arg, $key) =
8de02997 513 FindOption ($argv, $prefix, $argend, $opt, \%opctl);
bb40d378 514
e6d5c530 515 if ( $found ) {
0b7031a2 516
e6d5c530 517 # FindOption undefines $opt in case of errors.
bb40d378
JV
518 next unless defined $opt;
519
d4ad7505
RGS
520 my $argcnt = 0;
521 while ( defined $arg ) {
2d08fc49
JH
522
523 # Get the canonical name.
524 print STDERR ("=> cname for \"$opt\" is ") if $debug;
525 $opt = $ctl->[CTL_CNAME];
526 print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
bb40d378
JV
527
528 if ( defined $linkage{$opt} ) {
529 print STDERR ("=> ref(\$L{$opt}) -> ",
530 ref($linkage{$opt}), "\n") if $debug;
531
8de02997
RGS
532 if ( ref($linkage{$opt}) eq 'SCALAR'
533 || ref($linkage{$opt}) eq 'REF' ) {
2d08fc49 534 if ( $ctl->[CTL_TYPE] eq '+' ) {
e6d5c530
JV
535 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
536 if $debug;
537 if ( defined ${$linkage{$opt}} ) {
538 ${$linkage{$opt}} += $arg;
539 }
540 else {
541 ${$linkage{$opt}} = $arg;
542 }
543 }
9e01bed8
JH
544 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
545 print STDERR ("=> ref(\$L{$opt}) auto-vivified",
546 " to ARRAY\n")
547 if $debug;
548 my $t = $linkage{$opt};
549 $$t = $linkage{$opt} = [];
550 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
551 if $debug;
552 push (@{$linkage{$opt}}, $arg);
553 }
554 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
555 print STDERR ("=> ref(\$L{$opt}) auto-vivified",
556 " to HASH\n")
557 if $debug;
558 my $t = $linkage{$opt};
559 $$t = $linkage{$opt} = {};
560 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
561 if $debug;
562 $linkage{$opt}->{$key} = $arg;
563 }
e6d5c530
JV
564 else {
565 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
566 if $debug;
567 ${$linkage{$opt}} = $arg;
568 }
bb40d378
JV
569 }
570 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
571 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
572 if $debug;
573 push (@{$linkage{$opt}}, $arg);
574 }
575 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
576 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
577 if $debug;
578 $linkage{$opt}->{$key} = $arg;
579 }
580 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
2d08fc49
JH
581 print STDERR ("=> &L{$opt}(\"$opt\"",
582 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
583 ", \"$arg\")\n")
bb40d378 584 if $debug;
e71a68ed
JH
585 my $eval_error = do {
586 local $@;
a19443d4 587 local $SIG{__DIE__} = 'DEFAULT';
e71a68ed 588 eval {
8de02997
RGS
589 &{$linkage{$opt}}
590 (Getopt::Long::CallBack->new
591 (name => $opt,
592 ctl => $ctl,
593 opctl => \%opctl,
594 linkage => \%linkage,
595 prefix => $prefix,
596 ),
597 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
598 $arg);
e71a68ed
JH
599 };
600 $@;
0b7031a2 601 };
e71a68ed
JH
602 print STDERR ("=> die($eval_error)\n")
603 if $debug && $eval_error ne '';
604 if ( $eval_error =~ /^!/ ) {
605 if ( $eval_error =~ /^!FINISH\b/ ) {
bee0ef1e
GS
606 $goon = 0;
607 }
0b7031a2 608 }
e71a68ed
JH
609 elsif ( $eval_error ne '' ) {
610 warn ($eval_error);
0b7031a2
GS
611 $error++;
612 }
bb40d378
JV
613 }
614 else {
615 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
616 "\" in linkage\n");
eab822e5 617 die("Getopt::Long -- internal error!\n");
bb40d378
JV
618 }
619 }
620 # No entry in linkage means entry in userlinkage.
2d08fc49 621 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
bb40d378
JV
622 if ( defined $userlinkage->{$opt} ) {
623 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
624 if $debug;
625 push (@{$userlinkage->{$opt}}, $arg);
626 }
627 else {
628 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
629 if $debug;
630 $userlinkage->{$opt} = [$arg];
631 }
632 }
2d08fc49 633 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
bb40d378
JV
634 if ( defined $userlinkage->{$opt} ) {
635 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
636 if $debug;
637 $userlinkage->{$opt}->{$key} = $arg;
638 }
639 else {
640 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
641 if $debug;
642 $userlinkage->{$opt} = {$key => $arg};
643 }
644 }
645 else {
2d08fc49 646 if ( $ctl->[CTL_TYPE] eq '+' ) {
e6d5c530
JV
647 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
648 if $debug;
649 if ( defined $userlinkage->{$opt} ) {
650 $userlinkage->{$opt} += $arg;
651 }
652 else {
653 $userlinkage->{$opt} = $arg;
654 }
655 }
656 else {
657 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
658 $userlinkage->{$opt} = $arg;
659 }
bb40d378 660 }
d4ad7505
RGS
661
662 $argcnt++;
554627f6 663 last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
d4ad7505
RGS
664 undef($arg);
665
666 # Need more args?
667 if ( $argcnt < $ctl->[CTL_AMIN] ) {
8de02997
RGS
668 if ( @$argv ) {
669 if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
670 $arg = shift(@$argv);
cdac3961
CBW
671 if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
672 $arg =~ tr/_//d;
673 $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
674 ? oct($arg)
675 : 0+$arg
676 }
d4ad7505
RGS
677 ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
678 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
679 next;
680 }
8de02997 681 warn("Value \"$$argv[0]\" invalid for option $opt\n");
d4ad7505
RGS
682 $error++;
683 }
684 else {
685 warn("Insufficient arguments for option $opt\n");
686 $error++;
687 }
688 }
689
690 # Any more args?
8de02997
RGS
691 if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
692 $arg = shift(@$argv);
cdac3961
CBW
693 if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
694 $arg =~ tr/_//d;
695 $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
696 ? oct($arg)
697 : 0+$arg
698 }
d4ad7505
RGS
699 ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
700 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
701 next;
702 }
bb40d378
JV
703 }
704 }
705
706 # Not an option. Save it if we $PERMUTE and don't have a <>.
707 elsif ( $order == $PERMUTE ) {
708 # Try non-options call-back.
709 my $cb;
710 if ( (defined ($cb = $linkage{'<>'})) ) {
2d08fc49
JH
711 print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
712 if $debug;
e71a68ed
JH
713 my $eval_error = do {
714 local $@;
a19443d4
RGS
715 local $SIG{__DIE__} = 'DEFAULT';
716 eval {
cdac3961
CBW
717 # The arg to <> cannot be the CallBack object
718 # since it may be passed to other modules that
719 # get confused (e.g., Archive::Tar). Well,
720 # it's not relevant for this callback anyway.
721 &$cb($tryopt);
a19443d4 722 };
e71a68ed 723 $@;
0b7031a2 724 };
e71a68ed
JH
725 print STDERR ("=> die($eval_error)\n")
726 if $debug && $eval_error ne '';
727 if ( $eval_error =~ /^!/ ) {
728 if ( $eval_error =~ /^!FINISH\b/ ) {
bee0ef1e
GS
729 $goon = 0;
730 }
0b7031a2 731 }
e71a68ed
JH
732 elsif ( $eval_error ne '' ) {
733 warn ($eval_error);
0b7031a2
GS
734 $error++;
735 }
bb40d378
JV
736 }
737 else {
738 print STDERR ("=> saving \"$tryopt\" ",
739 "(not an option, may permute)\n") if $debug;
740 push (@ret, $tryopt);
741 }
742 next;
743 }
744
745 # ...otherwise, terminate.
746 else {
747 # Push this one back and exit.
8de02997 748 unshift (@$argv, $tryopt);
bb40d378
JV
749 return ($error == 0);
750 }
751
752 }
753
754 # Finish.
2d08fc49 755 if ( @ret && $order == $PERMUTE ) {
bb40d378
JV
756 # Push back accumulated arguments
757 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
2d08fc49 758 if $debug;
8de02997 759 unshift (@$argv, @ret);
bb40d378
JV
760 }
761
762 return ($error == 0);
763}
764
2d08fc49
JH
765# A readable representation of what's in an optbl.
766sub OptCtl ($) {
767 my ($v) = @_;
768 my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
769 "[".
770 join(",",
771 "\"$v[CTL_TYPE]\"",
bd444ebb 772 "\"$v[CTL_CNAME]\"",
bd444ebb 773 "\"$v[CTL_DEFAULT]\"",
d4ad7505
RGS
774 ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
775 $v[CTL_AMIN] || '',
776 $v[CTL_AMAX] || '',
bd444ebb
JH
777# $v[CTL_RANGE] || '',
778# $v[CTL_REPEAT] || '',
2d08fc49
JH
779 ). "]";
780}
781
782# Parse an option specification and fill the tables.
783sub ParseOptionSpec ($$) {
784 my ($opt, $opctl) = @_;
785
bd444ebb 786 # Match option spec.
2d08fc49
JH
787 if ( $opt !~ m;^
788 (
789 # Option name
790 (?: \w+[-\w]* )
791 # Alias names, or "?"
a19443d4 792 (?: \| (?: \? | \w[-\w]* ) )*
cdac3961
CBW
793 # Aliases
794 (?: \| (?: [^-|!+=:][^|!+=:]* )? )*
2d08fc49
JH
795 )?
796 (
797 # Either modifiers ...
798 [!+]
799 |
d4ad7505
RGS
800 # ... or a value/dest/repeat specification
801 [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
bd444ebb
JH
802 |
803 # ... or an optional-with-default spec
804 : (?: -?\d+ | \+ ) [@%]?
2d08fc49
JH
805 )?
806 $;x ) {
807 return (undef, "Error in option spec: \"$opt\"\n");
808 }
809
810 my ($names, $spec) = ($1, $2);
811 $spec = '' unless defined $spec;
812
813 # $orig keeps track of the primary name the user specified.
814 # This name will be used for the internal or external linkage.
815 # In other words, if the user specifies "FoO|BaR", it will
816 # match any case combinations of 'foo' and 'bar', but if a global
817 # variable needs to be set, it will be $opt_FoO in the exact case
818 # as specified.
819 my $orig;
820
821 my @names;
822 if ( defined $names ) {
823 @names = split (/\|/, $names);
824 $orig = $names[0];
825 }
826 else {
827 @names = ('');
828 $orig = '';
829 }
830
831 # Construct the opctl entries.
832 my $entry;
833 if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
bd444ebb 834 # Fields are hard-wired here.
d4ad7505 835 $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
bd444ebb 836 }
d4ad7505 837 elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
bd444ebb
JH
838 my $def = $1;
839 my $dest = $2;
840 my $type = $def eq '+' ? 'I' : 'i';
841 $dest ||= '$';
842 $dest = $dest eq '@' ? CTL_DEST_ARRAY
843 : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
844 # Fields are hard-wired here.
d4ad7505
RGS
845 $entry = [$type,$orig,$def eq '+' ? undef : $def,
846 $dest,0,1];
2d08fc49
JH
847 }
848 else {
d4ad7505
RGS
849 my ($mand, $type, $dest) =
850 $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
851 return (undef, "Cannot repeat while bundling: \"$opt\"\n")
852 if $bundling && defined($4);
853 my ($mi, $cm, $ma) = ($5, $6, $7);
854 return (undef, "{0} is useless in option spec: \"$opt\"\n")
855 if defined($mi) && !$mi && !defined($ma) && !defined($cm);
856
2d08fc49
JH
857 $type = 'i' if $type eq 'n';
858 $dest ||= '$';
859 $dest = $dest eq '@' ? CTL_DEST_ARRAY
860 : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
d4ad7505
RGS
861 # Default minargs to 1/0 depending on mand status.
862 $mi = $mand eq '=' ? 1 : 0 unless defined $mi;
863 # Adjust mand status according to minargs.
864 $mand = $mi ? '=' : ':';
865 # Adjust maxargs.
866 $ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
867 return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
868 if defined($ma) && !$ma;
869 return (undef, "Max less than min in option spec: \"$opt\"\n")
870 if defined($ma) && $ma < $mi;
871
bd444ebb 872 # Fields are hard-wired here.
d4ad7505 873 $entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
2d08fc49
JH
874 }
875
876 # Process all names. First is canonical, the rest are aliases.
bd444ebb 877 my $dups = '';
2d08fc49
JH
878 foreach ( @names ) {
879
880 $_ = lc ($_)
881 if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
882
bd444ebb
JH
883 if ( exists $opctl->{$_} ) {
884 $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
885 }
886
2d08fc49
JH
887 if ( $spec eq '!' ) {
888 $opctl->{"no$_"} = $entry;
10933be5 889 $opctl->{"no-$_"} = $entry;
2d08fc49
JH
890 $opctl->{$_} = [@$entry];
891 $opctl->{$_}->[CTL_TYPE] = '';
892 }
893 else {
894 $opctl->{$_} = $entry;
895 }
896 }
897
bd444ebb 898 if ( $dups && $^W ) {
bd444ebb 899 foreach ( split(/\n+/, $dups) ) {
eab822e5 900 warn($_."\n");
bd444ebb
JH
901 }
902 }
2d08fc49
JH
903 ($names[0], $orig);
904}
905
e6d5c530 906# Option lookup.
8de02997 907sub FindOption ($$$$$) {
bb40d378 908
2d08fc49
JH
909 # returns (1, $opt, $ctl, $arg, $key) if okay,
910 # returns (1, undef) if option in error,
e6d5c530 911 # returns (0) otherwise.
bb40d378 912
8de02997 913 my ($argv, $prefix, $argend, $opt, $opctl) = @_;
bb40d378 914
2d08fc49 915 print STDERR ("=> find \"$opt\"\n") if $debug;
bb40d378 916
cdac3961
CBW
917 return (0) unless defined($opt);
918 return (0) unless $opt =~ /^($prefix)(.*)$/s;
bd444ebb 919 return (0) if $opt eq "-" && !defined $opctl->{''};
bb40d378 920
cdac3961 921 $opt = substr( $opt, length($1) ); # retain taintedness
2d08fc49 922 my $starter = $1;
bb40d378
JV
923
924 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
925
2d08fc49
JH
926 my $optarg; # value supplied with --opt=value
927 my $rest; # remainder from unbundling
bb40d378
JV
928
929 # If it is a long option, it may include the value.
2d08fc49 930 # With getopt_compat, only if not bundling.
554627f6 931 if ( ($starter=~/^$longprefix$/
cdac3961
CBW
932 || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
933 && (my $oppos = index($opt, '=', 1)) > 0) {
934 my $optorg = $opt;
935 $opt = substr($optorg, 0, $oppos);
936 $optarg = substr($optorg, $oppos + 1); # retain tainedness
0b7031a2 937 print STDERR ("=> option \"", $opt,
bb40d378
JV
938 "\", optarg = \"$optarg\"\n") if $debug;
939 }
940
941 #### Look it up ###
942
eab822e5 943 my $tryopt = $opt; # option to try
bb40d378
JV
944
945 if ( $bundling && $starter eq '-' ) {
2d08fc49 946
b844f03e 947 # To try overrides, obey case ignore.
2d08fc49 948 $tryopt = $ignorecase ? lc($opt) : $opt;
bb40d378
JV
949
950 # If bundling == 2, long options can override bundles.
b844f03e
JH
951 if ( $bundling == 2 && length($tryopt) > 1
952 && defined ($opctl->{$tryopt}) ) {
2d08fc49
JH
953 print STDERR ("=> $starter$tryopt overrides unbundling\n")
954 if $debug;
955 }
956 else {
957 $tryopt = $opt;
958 # Unbundle single letter option.
bd444ebb 959 $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
2d08fc49
JH
960 $tryopt = substr ($tryopt, 0, 1);
961 $tryopt = lc ($tryopt) if $ignorecase > 1;
962 print STDERR ("=> $starter$tryopt unbundled from ",
bb40d378 963 "$starter$tryopt$rest\n") if $debug;
2d08fc49 964 $rest = undef unless $rest ne '';
bb40d378 965 }
0b7031a2 966 }
bb40d378
JV
967
968 # Try auto-abbreviation.
a19443d4 969 elsif ( $autoabbrev && $opt ne "" ) {
2d08fc49
JH
970 # Sort the possible long option names.
971 my @names = sort(keys (%$opctl));
bb40d378 972 # Downcase if allowed.
2d08fc49
JH
973 $opt = lc ($opt) if $ignorecase;
974 $tryopt = $opt;
bb40d378
JV
975 # Turn option name into pattern.
976 my $pat = quotemeta ($opt);
977 # Look up in option names.
2d08fc49 978 my @hits = grep (/^$pat/, @names);
bb40d378 979 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
2d08fc49 980 "out of ", scalar(@names), "\n") if $debug;
bb40d378
JV
981
982 # Check for ambiguous results.
983 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
984 # See if all matches are for the same option.
985 my %hit;
986 foreach ( @hits ) {
654bf526
CBW
987 my $hit = $opctl->{$_}->[CTL_CNAME]
988 if defined $opctl->{$_}->[CTL_CNAME];
989 $hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!';
554627f6 990 $hit{$hit} = 1;
bb40d378 991 }
9e01bed8
JH
992 # Remove auto-supplied options (version, help).
993 if ( keys(%hit) == 2 ) {
994 if ( $auto_version && exists($hit{version}) ) {
995 delete $hit{version};
996 }
997 elsif ( $auto_help && exists($hit{help}) ) {
998 delete $hit{help};
999 }
1000 }
bb40d378
JV
1001 # Now see if it really is ambiguous.
1002 unless ( keys(%hit) == 1 ) {
e6d5c530 1003 return (0) if $passthrough;
bb40d378
JV
1004 warn ("Option ", $opt, " is ambiguous (",
1005 join(", ", @hits), ")\n");
1006 $error++;
2d08fc49 1007 return (1, undef);
bb40d378
JV
1008 }
1009 @hits = keys(%hit);
1010 }
1011
1012 # Complete the option name, if appropriate.
1013 if ( @hits == 1 && $hits[0] ne $opt ) {
1014 $tryopt = $hits[0];
1015 $tryopt = lc ($tryopt) if $ignorecase;
1016 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
1017 if $debug;
1018 }
1019 }
1020
1021 # Map to all lowercase if ignoring case.
1022 elsif ( $ignorecase ) {
1023 $tryopt = lc ($opt);
1024 }
1025
1026 # Check validity by fetching the info.
2d08fc49
JH
1027 my $ctl = $opctl->{$tryopt};
1028 unless ( defined $ctl ) {
e6d5c530 1029 return (0) if $passthrough;
9e01bed8 1030 # Pretend one char when bundling.
554627f6 1031 if ( $bundling == 1 && length($starter) == 1 ) {
9e01bed8 1032 $opt = substr($opt,0,1);
8de02997 1033 unshift (@$argv, $starter.$rest) if defined $rest;
9e01bed8 1034 }
a19443d4
RGS
1035 if ( $opt eq "" ) {
1036 warn ("Missing option after ", $starter, "\n");
1037 }
1038 else {
1039 warn ("Unknown option: ", $opt, "\n");
1040 }
bb40d378 1041 $error++;
2d08fc49 1042 return (1, undef);
bb40d378
JV
1043 }
1044 # Apparently valid.
1045 $opt = $tryopt;
2d08fc49
JH
1046 print STDERR ("=> found ", OptCtl($ctl),
1047 " for \"", $opt, "\"\n") if $debug;
bb40d378
JV
1048
1049 #### Determine argument status ####
1050
1051 # If it is an option w/o argument, we're almost finished with it.
2d08fc49
JH
1052 my $type = $ctl->[CTL_TYPE];
1053 my $arg;
1054
e6d5c530 1055 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
bb40d378 1056 if ( defined $optarg ) {
e6d5c530 1057 return (0) if $passthrough;
bb40d378
JV
1058 warn ("Option ", $opt, " does not take an argument\n");
1059 $error++;
1060 undef $opt;
1061 }
e6d5c530 1062 elsif ( $type eq '' || $type eq '+' ) {
bd444ebb
JH
1063 # Supply explicit value.
1064 $arg = 1;
bb40d378
JV
1065 }
1066 else {
10933be5 1067 $opt =~ s/^no-?//i; # strip NO prefix
bb40d378
JV
1068 $arg = 0; # supply explicit value
1069 }
8de02997 1070 unshift (@$argv, $starter.$rest) if defined $rest;
2d08fc49 1071 return (1, $opt, $ctl, $arg);
bb40d378
JV
1072 }
1073
1074 # Get mandatory status and type info.
d4ad7505 1075 my $mand = $ctl->[CTL_AMIN];
bb40d378
JV
1076
1077 # Check if there is an option argument available.
bd444ebb 1078 if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
4c56f247 1079 return (1, $opt, $ctl, $type eq 's' ? '' : 0) ;#unless $mand;
bd444ebb 1080 $optarg = 0 unless $type eq 's';
10e5c9cc
JH
1081 }
1082
1083 # Check if there is an option argument available.
1084 if ( defined $optarg
1085 ? ($optarg eq '')
8de02997 1086 : !(defined $rest || @$argv > 0) ) {
bb40d378 1087 # Complain if this option needs an argument.
4c56f247 1088# if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
2d08fc49 1089 if ( $mand ) {
e6d5c530 1090 return (0) if $passthrough;
bb40d378
JV
1091 warn ("Option ", $opt, " requires an argument\n");
1092 $error++;
2d08fc49 1093 return (1, undef);
bb40d378 1094 }
bd444ebb
JH
1095 if ( $type eq 'I' ) {
1096 # Fake incremental type.
1097 my @c = @$ctl;
1098 $c[CTL_TYPE] = '+';
1099 return (1, $opt, \@c, 1);
1100 }
1101 return (1, $opt, $ctl,
1102 defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1103 $type eq 's' ? '' : 0);
bb40d378
JV
1104 }
1105
1106 # Get (possibly optional) argument.
1107 $arg = (defined $rest ? $rest
8de02997 1108 : (defined $optarg ? $optarg : shift (@$argv)));
bb40d378
JV
1109
1110 # Get key if this is a "name=value" pair for a hash option.
2d08fc49
JH
1111 my $key;
1112 if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
18172392 1113 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
10933be5
RGS
1114 : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1115 ($mand ? undef : ($type eq 's' ? "" : 1)));
1116 if (! defined $arg) {
1117 warn ("Option $opt, key \"$key\", requires a value\n");
1118 $error++;
1119 # Push back.
8de02997 1120 unshift (@$argv, $starter.$rest) if defined $rest;
10933be5
RGS
1121 return (1, undef);
1122 }
bb40d378
JV
1123 }
1124
1125 #### Check if the argument is valid for this option ####
1126
10933be5
RGS
1127 my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
1128
bd444ebb 1129 if ( $type eq 's' ) { # string
0b7031a2 1130 # A mandatory string takes anything.
2d08fc49 1131 return (1, $opt, $ctl, $arg, $key) if $mand;
bb40d378 1132
8de02997
RGS
1133 # Same for optional string as a hash value
1134 return (1, $opt, $ctl, $arg, $key)
1135 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
1136
0b7031a2 1137 # An optional string takes almost anything.
2d08fc49 1138 return (1, $opt, $ctl, $arg, $key)
e6d5c530 1139 if defined $optarg || defined $rest;
2d08fc49 1140 return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
bb40d378
JV
1141
1142 # Check for option or option list terminator.
1143 if ($arg eq $argend ||
e6d5c530 1144 $arg =~ /^$prefix.+/) {
bb40d378 1145 # Push back.
8de02997 1146 unshift (@$argv, $arg);
bb40d378
JV
1147 # Supply empty value.
1148 $arg = '';
1149 }
1150 }
1151
bd444ebb
JH
1152 elsif ( $type eq 'i' # numeric/integer
1153 || $type eq 'I' # numeric/integer w/ incr default
1154 || $type eq 'o' ) { # dec/oct/hex/bin value
7d1b667f 1155
8de02997 1156 my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
7d1b667f 1157
10933be5
RGS
1158 if ( $bundling && defined $rest
1159 && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
1160 ($key, $arg, $rest) = ($1, $2, $+);
1161 chop($key) if $key;
bd444ebb 1162 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
8de02997 1163 unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
bb40d378 1164 }
8de02997
RGS
1165 elsif ( $arg =~ /^$o_valid$/si ) {
1166 $arg =~ tr/_//d;
bd444ebb 1167 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
7d1b667f
JH
1168 }
1169 else {
2d08fc49 1170 if ( defined $optarg || $mand ) {
bb40d378 1171 if ( $passthrough ) {
8de02997 1172 unshift (@$argv, defined $rest ? $starter.$rest : $arg)
bb40d378 1173 unless defined $optarg;
e6d5c530 1174 return (0);
bb40d378
JV
1175 }
1176 warn ("Value \"", $arg, "\" invalid for option ",
7d1b667f 1177 $opt, " (",
bd444ebb 1178 $type eq 'o' ? "extended " : '',
7d1b667f 1179 "number expected)\n");
bb40d378 1180 $error++;
bb40d378 1181 # Push back.
8de02997 1182 unshift (@$argv, $starter.$rest) if defined $rest;
2d08fc49 1183 return (1, undef);
bb40d378
JV
1184 }
1185 else {
1186 # Push back.
8de02997 1187 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
bd444ebb
JH
1188 if ( $type eq 'I' ) {
1189 # Fake incremental type.
1190 my @c = @$ctl;
1191 $c[CTL_TYPE] = '+';
1192 return (1, $opt, \@c, 1);
1193 }
bb40d378 1194 # Supply default value.
bd444ebb 1195 $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
bb40d378
JV
1196 }
1197 }
1198 }
1199
bd444ebb 1200 elsif ( $type eq 'f' ) { # real number, int is also ok
bb40d378
JV
1201 # We require at least one digit before a point or 'e',
1202 # and at least one digit following the point and 'e'.
8de02997 1203 my $o_valid = PAT_FLOAT;
bb40d378 1204 if ( $bundling && defined $rest &&
8de02997
RGS
1205 $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
1206 $arg =~ tr/_//d;
10933be5
RGS
1207 ($key, $arg, $rest) = ($1, $2, $+);
1208 chop($key) if $key;
8de02997 1209 unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
bb40d378 1210 }
8de02997
RGS
1211 elsif ( $arg =~ /^$o_valid$/ ) {
1212 $arg =~ tr/_//d;
1213 }
1214 else {
2d08fc49 1215 if ( defined $optarg || $mand ) {
bb40d378 1216 if ( $passthrough ) {
8de02997 1217 unshift (@$argv, defined $rest ? $starter.$rest : $arg)
bb40d378 1218 unless defined $optarg;
e6d5c530 1219 return (0);
bb40d378
JV
1220 }
1221 warn ("Value \"", $arg, "\" invalid for option ",
1222 $opt, " (real number expected)\n");
1223 $error++;
bb40d378 1224 # Push back.
8de02997 1225 unshift (@$argv, $starter.$rest) if defined $rest;
2d08fc49 1226 return (1, undef);
bb40d378
JV
1227 }
1228 else {
1229 # Push back.
8de02997 1230 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
bb40d378
JV
1231 # Supply default value.
1232 $arg = 0.0;
1233 }
1234 }
1235 }
1236 else {
10933be5 1237 die("Getopt::Long internal error (Can't happen)\n");
bb40d378 1238 }
2d08fc49 1239 return (1, $opt, $ctl, $arg, $key);
e6d5c530 1240}
bb40d378 1241
d4ad7505
RGS
1242sub ValidValue ($$$$$) {
1243 my ($ctl, $arg, $mand, $argend, $prefix) = @_;
1244
1245 if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
1246 return 0 unless $arg =~ /[^=]+=(.*)/;
1247 $arg = $1;
1248 }
1249
1250 my $type = $ctl->[CTL_TYPE];
1251
1252 if ( $type eq 's' ) { # string
1253 # A mandatory string takes anything.
1254 return (1) if $mand;
1255
1256 return (1) if $arg eq "-";
1257
1258 # Check for option or option list terminator.
1259 return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
1260 return 1;
1261 }
1262
1263 elsif ( $type eq 'i' # numeric/integer
1264 || $type eq 'I' # numeric/integer w/ incr default
1265 || $type eq 'o' ) { # dec/oct/hex/bin value
1266
8de02997 1267 my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
d4ad7505
RGS
1268 return $arg =~ /^$o_valid$/si;
1269 }
1270
1271 elsif ( $type eq 'f' ) { # real number, int is also ok
1272 # We require at least one digit before a point or 'e',
1273 # and at least one digit following the point and 'e'.
1274 # [-]NN[.NN][eNN]
8de02997
RGS
1275 my $o_valid = PAT_FLOAT;
1276 return $arg =~ /^$o_valid$/;
d4ad7505
RGS
1277 }
1278 die("ValidValue: Cannot happen\n");
1279}
1280
e6d5c530
JV
1281# Getopt::Long Configuration.
1282sub Configure (@) {
1283 my (@options) = @_;
0b7031a2
GS
1284
1285 my $prevconfig =
1286 [ $error, $debug, $major_version, $minor_version,
1287 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
554627f6
RGS
1288 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1289 $longprefix ];
0b7031a2
GS
1290
1291 if ( ref($options[0]) eq 'ARRAY' ) {
1292 ( $error, $debug, $major_version, $minor_version,
1293 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
554627f6
RGS
1294 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1295 $longprefix ) = @{shift(@options)};
0b7031a2
GS
1296 }
1297
e6d5c530
JV
1298 my $opt;
1299 foreach $opt ( @options ) {
1300 my $try = lc ($opt);
1301 my $action = 1;
1302 if ( $try =~ /^no_?(.*)$/s ) {
1303 $action = 0;
1304 $try = $+;
1305 }
10e5c9cc
JH
1306 if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
1307 ConfigDefaults ();
1308 }
1309 elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
1310 local $ENV{POSIXLY_CORRECT};
1311 $ENV{POSIXLY_CORRECT} = 1 if $action;
1312 ConfigDefaults ();
e6d5c530
JV
1313 }
1314 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
1315 $autoabbrev = $action;
1316 }
1317 elsif ( $try eq 'getopt_compat' ) {
1318 $getopt_compat = $action;
70e28ff3 1319 $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
e6d5c530 1320 }
10e5c9cc
JH
1321 elsif ( $try eq 'gnu_getopt' ) {
1322 if ( $action ) {
1323 $gnu_compat = 1;
1324 $bundling = 1;
1325 $getopt_compat = 0;
70e28ff3 1326 $genprefix = "(--|-)";
2d08fc49 1327 $order = $PERMUTE;
10e5c9cc
JH
1328 }
1329 }
1330 elsif ( $try eq 'gnu_compat' ) {
1331 $gnu_compat = $action;
1332 }
10933be5
RGS
1333 elsif ( $try =~ /^(auto_?)?version$/ ) {
1334 $auto_version = $action;
1335 }
1336 elsif ( $try =~ /^(auto_?)?help$/ ) {
1337 $auto_help = $action;
1338 }
e6d5c530
JV
1339 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
1340 $ignorecase = $action;
1341 }
8de02997 1342 elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
e6d5c530
JV
1343 $ignorecase = $action ? 2 : 0;
1344 }
1345 elsif ( $try eq 'bundling' ) {
1346 $bundling = $action;
1347 }
1348 elsif ( $try eq 'bundling_override' ) {
1349 $bundling = $action ? 2 : 0;
1350 }
1351 elsif ( $try eq 'require_order' ) {
1352 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
1353 }
1354 elsif ( $try eq 'permute' ) {
1355 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
1356 }
1357 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
1358 $passthrough = $action;
1359 }
10e5c9cc 1360 elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
e6d5c530
JV
1361 $genprefix = $1;
1362 # Turn into regexp. Needs to be parenthesized!
1363 $genprefix = "(" . quotemeta($genprefix) . ")";
1364 eval { '' =~ /$genprefix/; };
cdac3961 1365 die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
e6d5c530 1366 }
10e5c9cc 1367 elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
e6d5c530
JV
1368 $genprefix = $1;
1369 # Parenthesize if needed.
0b7031a2 1370 $genprefix = "(" . $genprefix . ")"
e6d5c530 1371 unless $genprefix =~ /^\(.*\)$/;
554627f6 1372 eval { '' =~ m"$genprefix"; };
cdac3961 1373 die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
e6d5c530 1374 }
554627f6
RGS
1375 elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
1376 $longprefix = $1;
1377 # Parenthesize if needed.
1378 $longprefix = "(" . $longprefix . ")"
1379 unless $longprefix =~ /^\(.*\)$/;
1380 eval { '' =~ m"$longprefix"; };
cdac3961 1381 die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@;
554627f6 1382 }
e6d5c530
JV
1383 elsif ( $try eq 'debug' ) {
1384 $debug = $action;
1385 }
1386 else {
cdac3961 1387 die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")
e6d5c530 1388 }
bb40d378 1389 }
0b7031a2 1390 $prevconfig;
e6d5c530 1391}
bb40d378 1392
e6d5c530
JV
1393# Deprecated name.
1394sub config (@) {
1395 Configure (@_);
1396}
bb40d378 1397
10933be5
RGS
1398# Issue a standard message for --version.
1399#
1400# The arguments are mostly the same as for Pod::Usage::pod2usage:
1401#
1402# - a number (exit value)
1403# - a string (lead in message)
1404# - a hash with options. See Pod::Usage for details.
1405#
1406sub VersionMessage(@) {
1407 # Massage args.
1408 my $pa = setup_pa_args("version", @_);
1409
1410 my $v = $main::VERSION;
1411 my $fh = $pa->{-output} ||
1412 ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
1413
1414 print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
1415 $0, defined $v ? " version $v" : (),
1416 "\n",
1417 "(", __PACKAGE__, "::", "GetOptions",
1418 " version ",
79d0183a
RGS
1419 defined($Getopt::Long::VERSION_STRING)
1420 ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
10933be5
RGS
1421 " Perl version ",
1422 $] >= 5.006 ? sprintf("%vd", $^V) : $],
1423 ")\n");
1424 exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
1425}
1426
1427# Issue a standard message for --help.
1428#
1429# The arguments are the same as for Pod::Usage::pod2usage:
1430#
1431# - a number (exit value)
1432# - a string (lead in message)
1433# - a hash with options. See Pod::Usage for details.
1434#
1435sub HelpMessage(@) {
1436 eval {
1437 require Pod::Usage;
1438 import Pod::Usage;
1439 1;
1440 } || die("Cannot provide help: cannot load Pod::Usage\n");
1441
1442 # Note that pod2usage will issue a warning if -exitval => NOEXIT.
1443 pod2usage(setup_pa_args("help", @_));
1444
1445}
1446
1447# Helper routine to set up a normalized hash ref to be used as
1448# argument to pod2usage.
1449sub setup_pa_args($@) {
1450 my $tag = shift; # who's calling
1451
1452 # If called by direct binding to an option, it will get the option
1453 # name and value as arguments. Remove these, if so.
1454 @_ = () if @_ == 2 && $_[0] eq $tag;
1455
1456 my $pa;
1457 if ( @_ > 1 ) {
1458 $pa = { @_ };
1459 }
1460 else {
1461 $pa = shift || {};
1462 }
1463
1464 # At this point, $pa can be a number (exit value), string
1465 # (message) or hash with options.
1466
1467 if ( UNIVERSAL::isa($pa, 'HASH') ) {
1468 # Get rid of -msg vs. -message ambiguity.
1469 $pa->{-message} = $pa->{-msg};
1470 delete($pa->{-msg});
1471 }
1472 elsif ( $pa =~ /^-?\d+$/ ) {
1473 $pa = { -exitval => $pa };
1474 }
1475 else {
1476 $pa = { -message => $pa };
1477 }
1478
1479 # These are _our_ defaults.
1480 $pa->{-verbose} = 0 unless exists($pa->{-verbose});
1481 $pa->{-exitval} = 0 unless exists($pa->{-exitval});
1482 $pa;
1483}
1484
1485# Sneak way to know what version the user requested.
1486sub VERSION {
1487 $requested_version = $_[1];
1488 shift->SUPER::VERSION(@_);
1489}
1490
8de02997
RGS
1491package Getopt::Long::CallBack;
1492
1493sub new {
1494 my ($pkg, %atts) = @_;
1495 bless { %atts }, $pkg;
1496}
1497
1498sub name {
1499 my $self = shift;
1500 ''.$self->{name};
1501}
1502
1503use overload
a19443d4 1504 # Treat this object as an ordinary string for legacy API.
8de02997 1505 '""' => \&name,
8de02997
RGS
1506 fallback => 1;
1507
10933be5
RGS
15081;
1509
e6d5c530 1510################ Documentation ################
bb40d378
JV
1511
1512=head1 NAME
1513
0b7031a2 1514Getopt::Long - Extended processing of command line options
bb40d378
JV
1515
1516=head1 SYNOPSIS
1517
1518 use Getopt::Long;
7d1b667f
JH
1519 my $data = "file.dat";
1520 my $length = 24;
1521 my $verbose;
cdac3961
CBW
1522 GetOptions ("length=i" => \$length, # numeric
1523 "file=s" => \$data, # string
1524 "verbose" => \$verbose) # flag
1525 or die("Error in command line arguments\n");
bb40d378
JV
1526
1527=head1 DESCRIPTION
1528
1529The Getopt::Long module implements an extended getopt function called
cdac3961
CBW
1530GetOptions(). It parses the command line from C<@ARGV>, recognizing
1531and removing specified options and their possible values.
1532
1533This function adheres to the POSIX syntax for command
bb40d378
JV
1534line options, with GNU extensions. In general, this means that options
1535have long names instead of single letters, and are introduced with a
1536double dash "--". Support for bundling of command line options, as was
1537the case with the more traditional single-letter approach, is provided
0b7031a2
GS
1538but not enabled by default.
1539
1540=head1 Command Line Options, an Introduction
1541
1542Command line operated programs traditionally take their arguments from
1543the command line, for example filenames or other information that the
1544program needs to know. Besides arguments, these programs often take
1545command line I<options> as well. Options are not necessary for the
1546program to work, hence the name 'option', but are used to modify its
1547default behaviour. For example, a program could do its job quietly,
1548but with a suitable option it could provide verbose information about
1549what it did.
1550
1551Command line options come in several flavours. Historically, they are
1552preceded by a single dash C<->, and consist of a single letter.
1553
1554 -l -a -c
1555
1556Usually, these single-character options can be bundled:
1557
1558 -lac
1559
1560Options can have values, the value is placed after the option
1561character. Sometimes with whitespace in between, sometimes not:
1562
1563 -s 24 -s24
1564
1565Due to the very cryptic nature of these options, another style was
1566developed that used long names. So instead of a cryptic C<-l> one
1567could use the more descriptive C<--long>. To distinguish between a
1568bundle of single-character options and a long one, two dashes are used
1569to precede the option name. Early implementations of long options used
1570a plus C<+> instead. Also, option values could be specified either
10e5c9cc 1571like
0b7031a2
GS
1572
1573 --size=24
1574
1575or
1576
1577 --size 24
1578
1579The C<+> form is now obsolete and strongly deprecated.
1580
1581=head1 Getting Started with Getopt::Long
1582
0613d572
SP
1583Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
1584first Perl module that provided support for handling the new style of
cdac3961
CBW
1585command line options, in particular long option names, hence the Perl5
1586name Getopt::Long. This module also supports single-character options
1587and bundling.
0b7031a2
GS
1588
1589To use Getopt::Long from a Perl program, you must include the
1590following line in your Perl program:
1591
1592 use Getopt::Long;
1593
1594This will load the core of the Getopt::Long module and prepare your
1595program for using it. Most of the actual Getopt::Long code is not
1596loaded until you really call one of its functions.
1597
1598In the default configuration, options names may be abbreviated to
1599uniqueness, case does not matter, and a single dash is sufficient,
1600even for long option names. Also, options may be placed between
1601non-option arguments. See L<Configuring Getopt::Long> for more
1602details on how to configure Getopt::Long.
1603
1604=head2 Simple options
1605
1606The most simple options are the ones that take no values. Their mere
1607presence on the command line enables the option. Popular examples are:
1608
1609 --all --verbose --quiet --debug
1610
1611Handling simple options is straightforward:
1612
1613 my $verbose = ''; # option variable with default value (false)
1614 my $all = ''; # option variable with default value (false)
1615 GetOptions ('verbose' => \$verbose, 'all' => \$all);
1616
1617The call to GetOptions() parses the command line arguments that are
1618present in C<@ARGV> and sets the option variable to the value C<1> if
1619the option did occur on the command line. Otherwise, the option
1620variable is not touched. Setting the option value to true is often
1621called I<enabling> the option.
1622
1623The option name as specified to the GetOptions() function is called
1624the option I<specification>. Later we'll see that this specification
1625can contain more than just the option name. The reference to the
1626variable is called the option I<destination>.
1627
1628GetOptions() will return a true value if the command line could be
cdac3961
CBW
1629processed successfully. Otherwise, it will write error messages using
1630die() and warn(), and return a false result.
0b7031a2
GS
1631
1632=head2 A little bit less simple options
1633
1634Getopt::Long supports two useful variants of simple options:
1635I<negatable> options and I<incremental> options.
1636
d1be9408 1637A negatable option is specified with an exclamation mark C<!> after the
0b7031a2
GS
1638option name:
1639
1640 my $verbose = ''; # option variable with default value (false)
1641 GetOptions ('verbose!' => \$verbose);
1642
1643Now, using C<--verbose> on the command line will enable C<$verbose>,
1644as expected. But it is also allowed to use C<--noverbose>, which will
1645disable C<$verbose> by setting its value to C<0>. Using a suitable
1646default value, the program can find out whether C<$verbose> is false
1647by default, or disabled by using C<--noverbose>.
1648
1649An incremental option is specified with a plus C<+> after the
1650option name:
1651
1652 my $verbose = ''; # option variable with default value (false)
1653 GetOptions ('verbose+' => \$verbose);
1654
1655Using C<--verbose> on the command line will increment the value of
1656C<$verbose>. This way the program can keep track of how many times the
1657option occurred on the command line. For example, each occurrence of
1658C<--verbose> could increase the verbosity level of the program.
1659
1660=head2 Mixing command line option with other arguments
1661
1662Usually programs take command line options as well as other arguments,
1663for example, file names. It is good practice to always specify the
1664options first, and the other arguments last. Getopt::Long will,
1665however, allow the options and arguments to be mixed and 'filter out'
1666all the options before passing the rest of the arguments to the
1667program. To stop Getopt::Long from processing further arguments,
1668insert a double dash C<--> on the command line:
1669
1670 --size 24 -- --all
1671
1672In this example, C<--all> will I<not> be treated as an option, but
1673passed to the program unharmed, in C<@ARGV>.
1674
1675=head2 Options with values
1676
1677For options that take values it must be specified whether the option
1678value is required or not, and what kind of value the option expects.
1679
1680Three kinds of values are supported: integer numbers, floating point
1681numbers, and strings.
1682
1683If the option value is required, Getopt::Long will take the
1684command line argument that follows the option and assign this to the
1685option variable. If, however, the option value is specified as
1686optional, this will only be done if that value does not look like a
1687valid command line option itself.
bb40d378 1688
0b7031a2
GS
1689 my $tag = ''; # option variable with default value
1690 GetOptions ('tag=s' => \$tag);
bb40d378 1691
0b7031a2
GS
1692In the option specification, the option name is followed by an equals
1693sign C<=> and the letter C<s>. The equals sign indicates that this
1694option requires a value. The letter C<s> indicates that this value is
1695an arbitrary string. Other possible value types are C<i> for integer
1696values, and C<f> for floating point values. Using a colon C<:> instead
1697of the equals sign indicates that the option value is optional. In
1698this case, if no suitable value is supplied, string valued options get
1699an empty string C<''> assigned, while numeric options are set to C<0>.
bb40d378 1700
0b7031a2 1701=head2 Options with multiple values
bb40d378 1702
0b7031a2
GS
1703Options sometimes take several values. For example, a program could
1704use multiple directories to search for library files:
bb40d378 1705
0b7031a2 1706 --library lib/stdlib --library lib/extlib
bb40d378 1707
0b7031a2
GS
1708To accomplish this behaviour, simply specify an array reference as the
1709destination for the option:
bb40d378 1710
0b7031a2 1711 GetOptions ("library=s" => \@libfiles);
bb40d378 1712
9e01bed8
JH
1713Alternatively, you can specify that the option can have multiple
1714values by adding a "@", and pass a scalar reference as the
1715destination:
1716
1717 GetOptions ("library=s@" => \$libfiles);
1718
1719Used with the example above, C<@libfiles> (or C<@$libfiles>) would
cdac3961 1720contain two strings upon completion: C<"lib/stdlib"> and
9e01bed8 1721C<"lib/extlib">, in that order. It is also possible to specify that
0613d572 1722only integer or floating point numbers are acceptable values.
bb40d378 1723
0b7031a2
GS
1724Often it is useful to allow comma-separated lists of values as well as
1725multiple occurrences of the options. This is easy using Perl's split()
1726and join() operators:
bb40d378 1727
0b7031a2
GS
1728 GetOptions ("library=s" => \@libfiles);
1729 @libfiles = split(/,/,join(',',@libfiles));
bb40d378 1730
0b7031a2
GS
1731Of course, it is important to choose the right separator string for
1732each purpose.
3cb6de81 1733
d4ad7505
RGS
1734Warning: What follows is an experimental feature.
1735
1736Options can take multiple values at once, for example
1737
1738 --coordinates 52.2 16.4 --rgbcolor 255 255 149
1739
1740This can be accomplished by adding a repeat specifier to the option
1741specification. Repeat specifiers are very similar to the C<{...}>
1742repeat specifiers that can be used with regular expression patterns.
1743For example, the above command line would be handled as follows:
1744
1745 GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
1746
1747The destination for the option must be an array or array reference.
1748
1749It is also possible to specify the minimal and maximal number of
1750arguments an option takes. C<foo=s{2,4}> indicates an option that
cdac3961 1751takes at least two and at most 4 arguments. C<foo=s{1,}> indicates one
d4ad7505
RGS
1752or more values; C<foo:s{,}> indicates zero or more option values.
1753
0b7031a2 1754=head2 Options with hash values
bb40d378 1755
0b7031a2
GS
1756If the option destination is a reference to a hash, the option will
1757take, as value, strings of the form I<key>C<=>I<value>. The value will
1758be stored with the specified key in the hash.
bb40d378 1759
0b7031a2 1760 GetOptions ("define=s" => \%defines);
bb40d378 1761
9e01bed8
JH
1762Alternatively you can use:
1763
1764 GetOptions ("define=s%" => \$defines);
1765
0b7031a2
GS
1766When used with command line options:
1767
1768 --define os=linux --define vendor=redhat
1769
9e01bed8 1770the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
a19443d4 1771with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
9e01bed8 1772also possible to specify that only integer or floating point numbers
0613d572 1773are acceptable values. The keys are always taken to be strings.
0b7031a2
GS
1774
1775=head2 User-defined subroutines to handle options
1776
1777Ultimate control over what should be done when (actually: each time)
1778an option is encountered on the command line can be achieved by
1779designating a reference to a subroutine (or an anonymous subroutine)
1780as the option destination. When GetOptions() encounters the option, it
2d08fc49 1781will call the subroutine with two or three arguments. The first
a19443d4
RGS
1782argument is the name of the option. (Actually, it is an object that
1783stringifies to the name of the option.) For a scalar or array destination,
2d08fc49 1784the second argument is the value to be stored. For a hash destination,
cdac3961 1785the second argument is the key to the hash, and the third argument
2d08fc49
JH
1786the value to be stored. It is up to the subroutine to store the value,
1787or do whatever it thinks is appropriate.
0b7031a2
GS
1788
1789A trivial application of this mechanism is to implement options that
1790are related to each other. For example:
1791
1792 my $verbose = ''; # option variable with default value (false)
1793 GetOptions ('verbose' => \$verbose,
1794 'quiet' => sub { $verbose = 0 });
1795
1796Here C<--verbose> and C<--quiet> control the same variable
1797C<$verbose>, but with opposite values.
1798
1799If the subroutine needs to signal an error, it should call die() with
1800the desired error message as its argument. GetOptions() will catch the
1801die(), issue the error message, and record that an error result must
1802be returned upon completion.
1803
0613d572 1804If the text of the error message starts with an exclamation mark C<!>
bee0ef1e
GS
1805it is interpreted specially by GetOptions(). There is currently one
1806special command implemented: C<die("!FINISH")> will cause GetOptions()
1807to stop processing options, as if it encountered a double dash C<-->.
0b7031a2 1808
a19443d4
RGS
1809In version 2.37 the first argument to the callback function was
1810changed from string to object. This was done to make room for
1811extensions and more detailed control. The object stringifies to the
1812option name so this change should not introduce compatibility
1813problems.
1814
cdac3961
CBW
1815Here is an example of how to access the option name and value from within
1816a subroutine:
1817
1818 GetOptions ('opt=i' => \&handler);
1819 sub handler {
1820 my ($opt_name, $opt_value) = @_;
1821 print("Option name is $opt_name and value is $opt_value\n");
1822 }
1823
0b7031a2
GS
1824=head2 Options with multiple names
1825
1826Often it is user friendly to supply alternate mnemonic names for
1827options. For example C<--height> could be an alternate name for
1828C<--length>. Alternate names can be included in the option
1829specification, separated by vertical bar C<|> characters. To implement
1830the above example:
1831
1832 GetOptions ('length|height=f' => \$length);
1833
1834The first name is called the I<primary> name, the other names are
554627f6
RGS
1835called I<aliases>. When using a hash to store options, the key will
1836always be the primary name.
0b7031a2
GS
1837
1838Multiple alternate names are possible.
1839
1840=head2 Case and abbreviations
1841
1842Without additional configuration, GetOptions() will ignore the case of
1843option names, and allow the options to be abbreviated to uniqueness.
1844
1845 GetOptions ('length|height=f' => \$length, "head" => \$head);
1846
1847This call will allow C<--l> and C<--L> for the length option, but
1848requires a least C<--hea> and C<--hei> for the head and height options.
1849
1850=head2 Summary of Option Specifications
1851
1852Each option specifier consists of two parts: the name specification
10e5c9cc 1853and the argument specification.
0b7031a2
GS
1854
1855The name specification contains the name of the option, optionally
1856followed by a list of alternative names separated by vertical bar
10e5c9cc 1857characters.
0b7031a2
GS
1858
1859 length option name is "length"
1860 length|size|l name is "length", aliases are "size" and "l"
1861
1862The argument specification is optional. If omitted, the option is
1863considered boolean, a value of 1 will be assigned when the option is
1864used on the command line.
1865
1866The argument specification can be
1867
bbc7dcd2 1868=over 4
bb40d378
JV
1869
1870=item !
1871
0613d572
SP
1872The option does not take an argument and may be negated by prefixing
1873it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
18741 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
18750 will be assigned). If the option has aliases, this applies to the
1876aliases as well.
265c41c2
GS
1877
1878Using negation on a single letter option when bundling is in effect is
1879pointless and will result in a warning.
bb40d378 1880
e6d5c530
JV
1881=item +
1882
0b7031a2
GS
1883The option does not take an argument and will be incremented by 1
1884every time it appears on the command line. E.g. C<"more+">, when used
1885with C<--more --more --more>, will increment the value three times,
1886resulting in a value of 3 (provided it was 0 or undefined at first).
e6d5c530 1887
0b7031a2 1888The C<+> specifier is ignored if the option destination is not a scalar.
e6d5c530 1889
d4ad7505 1890=item = I<type> [ I<desttype> ] [ I<repeat> ]
bb40d378 1891
0b7031a2
GS
1892The option requires an argument of the given type. Supported types
1893are:
bb40d378 1894
bbc7dcd2 1895=over 4
bb40d378 1896
0b7031a2 1897=item s
bb40d378 1898
0b7031a2
GS
1899String. An arbitrary sequence of characters. It is valid for the
1900argument to start with C<-> or C<-->.
bb40d378 1901
0b7031a2 1902=item i
bb40d378 1903
0b7031a2
GS
1904Integer. An optional leading plus or minus sign, followed by a
1905sequence of digits.
bb40d378 1906
7d1b667f
JH
1907=item o
1908
1909Extended integer, Perl style. This can be either an optional leading
1910plus or minus sign, followed by a sequence of digits, or an octal
1911string (a zero, optionally followed by '0', '1', .. '7'), or a
1912hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
1913insensitive), or a binary string (C<0b> followed by a series of '0'
1914and '1').
1915
0b7031a2 1916=item f
bb40d378 1917
0b7031a2 1918Real number. For example C<3.14>, C<-6.23E24> and so on.
bb40d378 1919
0b7031a2
GS
1920=back
1921
1922The I<desttype> can be C<@> or C<%> to specify that the option is
1923list or a hash valued. This is only needed when the destination for
1924the option value is not otherwise specified. It should be omitted when
1925not needed.
1926
d4ad7505
RGS
1927The I<repeat> specifies the number of values this option takes per
1928occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
1929
1930I<min> denotes the minimal number of arguments. It defaults to 1 for
1931options with C<=> and to 0 for options with C<:>, see below. Note that
1932I<min> overrules the C<=> / C<:> semantics.
1933
1934I<max> denotes the maximum number of arguments. It must be at least
1935I<min>. If I<max> is omitted, I<but the comma is not>, there is no
1936upper bound to the number of argument values taken.
1937
0b7031a2 1938=item : I<type> [ I<desttype> ]
404cbe93 1939
0b7031a2
GS
1940Like C<=>, but designates the argument as optional.
1941If omitted, an empty string will be assigned to string values options,
1942and the value zero to numeric options.
404cbe93 1943
0b7031a2
GS
1944Note that if a string argument starts with C<-> or C<-->, it will be
1945considered an option on itself.
404cbe93 1946
bd444ebb
JH
1947=item : I<number> [ I<desttype> ]
1948
1949Like C<:i>, but if the value is omitted, the I<number> will be assigned.
1950
1951=item : + [ I<desttype> ]
1952
1953Like C<:i>, but if the value is omitted, the current value for the
1954option will be incremented.
1955
404cbe93
PP
1956=back
1957
0b7031a2 1958=head1 Advanced Possibilities
404cbe93 1959
10e5c9cc
JH
1960=head2 Object oriented interface
1961
1962Getopt::Long can be used in an object oriented way as well:
1963
1964 use Getopt::Long;
cdac3961 1965 $p = Getopt::Long::Parser->new;
10e5c9cc
JH
1966 $p->configure(...configuration options...);
1967 if ($p->getoptions(...options descriptions...)) ...
cdac3961 1968 if ($p->getoptionsfromarray( \@array, ...options descriptions...)) ...
10e5c9cc
JH
1969
1970Configuration options can be passed to the constructor:
1971
1972 $p = new Getopt::Long::Parser
1973 config => [...configuration options...];
1974
18172392
JH
1975=head2 Thread Safety
1976
1977Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is
1978I<not> thread safe when using the older (experimental and now
1979obsolete) threads implementation that was added to Perl 5.005.
10e5c9cc 1980
0b7031a2 1981=head2 Documentation and help texts
404cbe93 1982
0b7031a2
GS
1983Getopt::Long encourages the use of Pod::Usage to produce help
1984messages. For example:
404cbe93 1985
0b7031a2
GS
1986 use Getopt::Long;
1987 use Pod::Usage;
404cbe93 1988
0b7031a2
GS
1989 my $man = 0;
1990 my $help = 0;
404cbe93 1991
0b7031a2
GS
1992 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1993 pod2usage(1) if $help;
cdac3961 1994 pod2usage(-exitval => 0, -verbose => 2) if $man;
404cbe93 1995
0b7031a2 1996 __END__
404cbe93 1997
0b7031a2 1998 =head1 NAME
404cbe93 1999
10933be5 2000 sample - Using Getopt::Long and Pod::Usage
404cbe93 2001
0b7031a2 2002 =head1 SYNOPSIS
404cbe93 2003
0b7031a2 2004 sample [options] [file ...]
404cbe93 2005
0b7031a2
GS
2006 Options:
2007 -help brief help message
2008 -man full documentation
381319f7 2009
0b7031a2 2010 =head1 OPTIONS
381319f7 2011
0b7031a2 2012 =over 8
381319f7 2013
0b7031a2 2014 =item B<-help>
381319f7 2015
0b7031a2 2016 Print a brief help message and exits.
404cbe93 2017
0b7031a2 2018 =item B<-man>
404cbe93 2019
0b7031a2 2020 Prints the manual page and exits.
404cbe93 2021
0b7031a2 2022 =back
404cbe93 2023
0b7031a2 2024 =head1 DESCRIPTION
404cbe93 2025
db5d900a 2026 B<This program> will read the given input file(s) and do something
0b7031a2 2027 useful with the contents thereof.
404cbe93 2028
0b7031a2 2029 =cut
535b5725 2030
0b7031a2 2031See L<Pod::Usage> for details.
535b5725 2032
8de02997
RGS
2033=head2 Parsing options from an arbitrary array
2034
2035By default, GetOptions parses the options that are present in the
2036global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
2037used to parse options from an arbitrary array.
2038
2039 use Getopt::Long qw(GetOptionsFromArray);
2040 $ret = GetOptionsFromArray(\@myopts, ...);
2041
cdac3961
CBW
2042When used like this, options and their possible values are removed
2043from C<@myopts>, the global C<@ARGV> is not touched at all.
8de02997
RGS
2044
2045The following two calls behave identically:
2046
2047 $ret = GetOptions( ... );
2048 $ret = GetOptionsFromArray(\@ARGV, ... );
2049
cdac3961
CBW
2050This also means that a first argument hash reference now becomes the
2051second argument:
2052
2053 $ret = GetOptions(\%opts, ... );
2054 $ret = GetOptionsFromArray(\@ARGV, \%opts, ... );
2055
8de02997
RGS
2056=head2 Parsing options from an arbitrary string
2057
2058A special entry C<GetOptionsFromString> can be used to parse options
2059from an arbitrary string.
2060
2061 use Getopt::Long qw(GetOptionsFromString);
2062 $ret = GetOptionsFromString($string, ...);
2063
2064The contents of the string are split into arguments using a call to
2065C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
2066global C<@ARGV> is not touched.
2067
2068It is possible that, upon completion, not all arguments in the string
2069have been processed. C<GetOptionsFromString> will, when called in list
2070context, return both the return status and an array reference to any
2071remaining arguments:
2072
2073 ($ret, $args) = GetOptionsFromString($string, ... );
2074
2075If any arguments remain, and C<GetOptionsFromString> was not called in
2076list context, a message will be given and C<GetOptionsFromString> will
2077return failure.
2078
cdac3961
CBW
2079As with GetOptionsFromArray, a first argument hash reference now
2080becomes the second argument.
2081
8de02997 2082=head2 Storing options values in a hash
404cbe93 2083
0b7031a2
GS
2084Sometimes, for example when there are a lot of options, having a
2085separate variable for each of them can be cumbersome. GetOptions()
8de02997
RGS
2086supports, as an alternative mechanism, storing options values in a
2087hash.
404cbe93 2088
0b7031a2
GS
2089To obtain this, a reference to a hash must be passed I<as the first
2090argument> to GetOptions(). For each option that is specified on the
2091command line, the option value will be stored in the hash with the
2092option name as key. Options that are not actually used on the command
2093line will not be put in the hash, on other words,
2094C<exists($h{option})> (or defined()) can be used to test if an option
2095was used. The drawback is that warnings will be issued if the program
2096runs under C<use strict> and uses C<$h{option}> without testing with
2097exists() or defined() first.
381319f7 2098
0b7031a2
GS
2099 my %h = ();
2100 GetOptions (\%h, 'length=i'); # will store in $h{length}
f06db76b 2101
0b7031a2
GS
2102For options that take list or hash values, it is necessary to indicate
2103this by appending an C<@> or C<%> sign after the type:
f06db76b 2104
0b7031a2 2105 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
f06db76b 2106
0b7031a2
GS
2107To make things more complicated, the hash may contain references to
2108the actual destinations, for example:
f06db76b 2109
0b7031a2
GS
2110 my $len = 0;
2111 my %h = ('length' => \$len);
2112 GetOptions (\%h, 'length=i'); # will store in $len
f06db76b 2113
0b7031a2 2114This example is fully equivalent with:
a11f5414 2115
0b7031a2
GS
2116 my $len = 0;
2117 GetOptions ('length=i' => \$len); # will store in $len
f06db76b 2118
0b7031a2
GS
2119Any mixture is possible. For example, the most frequently used options
2120could be stored in variables while all other options get stored in the
2121hash:
f06db76b 2122
0b7031a2
GS
2123 my $verbose = 0; # frequently referred
2124 my $debug = 0; # frequently referred
2125 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
2126 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
2127 if ( $verbose ) { ... }
2128 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
f06db76b 2129
0b7031a2 2130=head2 Bundling
f06db76b 2131
0b7031a2
GS
2132With bundling it is possible to set several single-character options
2133at once. For example if C<a>, C<v> and C<x> are all valid options,
bb40d378 2134
0b7031a2 2135 -vax
bb40d378 2136
0b7031a2 2137would set all three.
f06db76b 2138
0b7031a2
GS
2139Getopt::Long supports two levels of bundling. To enable bundling, a
2140call to Getopt::Long::Configure is required.
bb40d378 2141
0b7031a2 2142The first level of bundling can be enabled with:
f06db76b 2143
0b7031a2 2144 Getopt::Long::Configure ("bundling");
404cbe93 2145
0b7031a2
GS
2146Configured this way, single-character options can be bundled but long
2147options B<must> always start with a double dash C<--> to avoid
0613d572 2148ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
0b7031a2 2149options,
404cbe93 2150
0b7031a2 2151 -vax
381319f7 2152
10e5c9cc 2153would set C<a>, C<v> and C<x>, but
404cbe93 2154
0b7031a2 2155 --vax
404cbe93 2156
0b7031a2 2157would set C<vax>.
a11f5414 2158
0b7031a2
GS
2159The second level of bundling lifts this restriction. It can be enabled
2160with:
a11f5414 2161
0b7031a2 2162 Getopt::Long::Configure ("bundling_override");
a11f5414 2163
0b7031a2 2164Now, C<-vax> would set the option C<vax>.
a11f5414 2165
0b7031a2
GS
2166When any level of bundling is enabled, option values may be inserted
2167in the bundle. For example:
381319f7 2168
0b7031a2 2169 -h24w80
f06db76b 2170
0b7031a2 2171is equivalent to
f06db76b 2172
0b7031a2 2173 -h 24 -w 80
f06db76b 2174
0b7031a2
GS
2175When configured for bundling, single-character options are matched
2176case sensitive while long options are matched case insensitive. To
2177have the single-character options matched case insensitive as well,
2178use:
a0d0e21e 2179
0b7031a2 2180 Getopt::Long::Configure ("bundling", "ignorecase_always");
a0d0e21e 2181
0b7031a2 2182It goes without saying that bundling can be quite confusing.
404cbe93 2183
0b7031a2 2184=head2 The lonesome dash
404cbe93 2185
ea071ac9
JH
2186Normally, a lone dash C<-> on the command line will not be considered
2187an option. Option processing will terminate (unless "permute" is
2188configured) and the dash will be left in C<@ARGV>.
2189
2190It is possible to get special treatment for a lone dash. This can be
2191achieved by adding an option specification with an empty name, for
2192example:
a0d0e21e 2193
0b7031a2 2194 GetOptions ('' => \$stdio);
a11f5414 2195
ea071ac9
JH
2196A lone dash on the command line will now be a legal option, and using
2197it will set variable C<$stdio>.
a0d0e21e 2198
2d08fc49 2199=head2 Argument callback
a0d0e21e 2200
10933be5 2201A special option 'name' C<< <> >> can be used to designate a subroutine
0b7031a2
GS
2202to handle non-option arguments. When GetOptions() encounters an
2203argument that does not look like an option, it will immediately call this
a19443d4
RGS
2204subroutine and passes it one parameter: the argument name. Well, actually
2205it is an object that stringifies to the argument name.
a0d0e21e 2206
0b7031a2 2207For example:
a0d0e21e 2208
0b7031a2
GS
2209 my $width = 80;
2210 sub process { ... }
2211 GetOptions ('width=i' => \$width, '<>' => \&process);
a0d0e21e 2212
0b7031a2 2213When applied to the following command line:
a11f5414 2214
0b7031a2 2215 arg1 --width=72 arg2 --width=60 arg3
404cbe93 2216
10e5c9cc
JH
2217This will call
2218C<process("arg1")> while C<$width> is C<80>,
0b7031a2
GS
2219C<process("arg2")> while C<$width> is C<72>, and
2220C<process("arg3")> while C<$width> is C<60>.
381319f7 2221
0b7031a2
GS
2222This feature requires configuration option B<permute>, see section
2223L<Configuring Getopt::Long>.
a0d0e21e 2224
0b7031a2
GS
2225=head1 Configuring Getopt::Long
2226
2227Getopt::Long can be configured by calling subroutine
2228Getopt::Long::Configure(). This subroutine takes a list of quoted
10e5c9cc
JH
2229strings, each specifying a configuration option to be enabled, e.g.
2230C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
0b7031a2 2231matter. Multiple calls to Configure() are possible.
404cbe93 2232
10e5c9cc
JH
2233Alternatively, as of version 2.24, the configuration options may be
2234passed together with the C<use> statement:
2235
2236 use Getopt::Long qw(:config no_ignore_case bundling);
2237
bb40d378 2238The following options are available:
404cbe93 2239
bb40d378 2240=over 12
a0d0e21e 2241
bb40d378 2242=item default
a0d0e21e 2243
bb40d378
JV
2244This option causes all configuration options to be reset to their
2245default values.
404cbe93 2246
10e5c9cc
JH
2247=item posix_default
2248
2249This option causes all configuration options to be reset to their
2250default values as if the environment variable POSIXLY_CORRECT had
2251been set.
2252
bb40d378 2253=item auto_abbrev
404cbe93 2254
bb40d378 2255Allow option names to be abbreviated to uniqueness.
10e5c9cc
JH
2256Default is enabled unless environment variable
2257POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
404cbe93 2258
0b7031a2 2259=item getopt_compat
a0d0e21e 2260
0b7031a2 2261Allow C<+> to start options.
10e5c9cc
JH
2262Default is enabled unless environment variable
2263POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
88e49c4e 2264
8ed53c8c
JH
2265=item gnu_compat
2266
2267C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
2268do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
2269C<--opt=> will give option C<opt> and empty value.
2270This is the way GNU getopt_long() does it.
2271
2272=item gnu_getopt
2273
2274This is a short way of setting C<gnu_compat> C<bundling> C<permute>
2275C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
2276fully compatible with GNU getopt_long().
2277
bb40d378 2278=item require_order
404cbe93 2279
0b7031a2 2280Whether command line arguments are allowed to be mixed with options.
10e5c9cc
JH
2281Default is disabled unless environment variable
2282POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
404cbe93 2283
0b7031a2 2284See also C<permute>, which is the opposite of C<require_order>.
a0d0e21e 2285
bb40d378 2286=item permute
404cbe93 2287
0b7031a2 2288Whether command line arguments are allowed to be mixed with options.
10e5c9cc
JH
2289Default is enabled unless environment variable
2290POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
0b7031a2 2291Note that C<permute> is the opposite of C<require_order>.
a0d0e21e 2292
10e5c9cc 2293If C<permute> is enabled, this means that
a0d0e21e 2294
0b7031a2 2295 --foo arg1 --bar arg2 arg3
a0d0e21e 2296
bb40d378 2297is equivalent to
a0d0e21e 2298
0b7031a2 2299 --foo --bar arg1 arg2 arg3
a0d0e21e 2300
2d08fc49 2301If an argument callback routine is specified, C<@ARGV> will always be
0613d572 2302empty upon successful return of GetOptions() since all options have been
0b7031a2 2303processed. The only exception is when C<--> is used:
a0d0e21e 2304
0b7031a2 2305 --foo arg1 --bar arg2 -- arg3
404cbe93 2306
2d08fc49 2307This will call the callback routine for arg1 and arg2, and then
4c56f247 2308terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
381319f7 2309
10e5c9cc 2310If C<require_order> is enabled, options processing
bb40d378 2311terminates when the first non-option is encountered.
a0d0e21e 2312
0b7031a2 2313 --foo arg1 --bar arg2 arg3
381319f7 2314
bb40d378 2315is equivalent to
381319f7 2316
0b7031a2 2317 --foo -- arg1 --bar arg2 arg3
404cbe93 2318
ac634a9a
JH
2319If C<pass_through> is also enabled, options processing will terminate
2320at the first unrecognized option, or non-option, whichever comes
2321first.
2322
10e5c9cc 2323=item bundling (default: disabled)
404cbe93 2324
bd444ebb
JH
2325Enabling this option will allow single-character options to be
2326bundled. To distinguish bundles from long option names, long options
2327I<must> be introduced with C<--> and bundles with C<->.
2328
2329Note that, if you have options C<a>, C<l> and C<all>, and
2330auto_abbrev enabled, possible arguments and option settings are:
2331
2332 using argument sets option(s)
2333 ------------------------------------------
2334 -a, --a a
2335 -l, --l l
2336 -al, -la, -ala, -all,... a, l
2337 --al, --all all
2338
0613d572 2339The surprising part is that C<--a> sets option C<a> (due to auto
bd444ebb 2340completion), not C<all>.
bb40d378 2341
10e5c9cc 2342Note: disabling C<bundling> also disables C<bundling_override>.
a11f5414 2343
10e5c9cc 2344=item bundling_override (default: disabled)
381319f7 2345
10e5c9cc
JH
2346If C<bundling_override> is enabled, bundling is enabled as with
2347C<bundling> but now long option names override option bundles.
381319f7 2348
10e5c9cc 2349Note: disabling C<bundling_override> also disables C<bundling>.
381319f7 2350
bb40d378
JV
2351B<Note:> Using option bundling can easily lead to unexpected results,
2352especially when mixing long options and bundles. Caveat emptor.
381319f7 2353
10e5c9cc 2354=item ignore_case (default: enabled)
381319f7 2355
cdac3961
CBW
2356If enabled, case is ignored when matching option names. If, however,
2357bundling is enabled as well, single character options will be treated
2358case-sensitive.
bd444ebb
JH
2359
2360With C<ignore_case>, option specifications for options that only
2361differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
2362duplicates.
381319f7 2363
10e5c9cc 2364Note: disabling C<ignore_case> also disables C<ignore_case_always>.
381319f7 2365
10e5c9cc 2366=item ignore_case_always (default: disabled)
a11f5414 2367
bb40d378 2368When bundling is in effect, case is ignored on single-character
10e5c9cc 2369options also.
381319f7 2370
10e5c9cc 2371Note: disabling C<ignore_case_always> also disables C<ignore_case>.
381319f7 2372
10933be5
RGS
2373=item auto_version (default:disabled)
2374
2375Automatically provide support for the B<--version> option if
2376the application did not specify a handler for this option itself.
2377
2378Getopt::Long will provide a standard version message that includes the
2379program name, its version (if $main::VERSION is defined), and the
2380versions of Getopt::Long and Perl. The message will be written to
2381standard output and processing will terminate.
2382
9e01bed8
JH
2383C<auto_version> will be enabled if the calling program explicitly
2384specified a version number higher than 2.32 in the C<use> or
2385C<require> statement.
2386
10933be5
RGS
2387=item auto_help (default:disabled)
2388
2389Automatically provide support for the B<--help> and B<-?> options if
2390the application did not specify a handler for this option itself.
2391
79d0183a 2392Getopt::Long will provide a help message using module L<Pod::Usage>. The
10933be5
RGS
2393message, derived from the SYNOPSIS POD section, will be written to
2394standard output and processing will terminate.
2395
9e01bed8
JH
2396C<auto_help> will be enabled if the calling program explicitly
2397specified a version number higher than 2.32 in the C<use> or
2398C<require> statement.
2399
10e5c9cc 2400=item pass_through (default: disabled)
a0d0e21e 2401
0b7031a2
GS
2402Options that are unknown, ambiguous or supplied with an invalid option
2403value are passed through in C<@ARGV> instead of being flagged as
2404errors. This makes it possible to write wrapper scripts that process
2405only part of the user supplied command line arguments, and pass the
bb40d378 2406remaining options to some other program.
a0d0e21e 2407
ac634a9a
JH
2408If C<require_order> is enabled, options processing will terminate at
2409the first unrecognized option, or non-option, whichever comes first.
2410However, if C<permute> is enabled instead, results can become confusing.
16c18a90 2411
10933be5
RGS
2412Note that the options terminator (default C<-->), if present, will
2413also be passed through in C<@ARGV>.
2414
3a0431da
JV
2415=item prefix
2416
0b7031a2
GS
2417The string that starts options. If a constant string is not
2418sufficient, see C<prefix_pattern>.
3a0431da
JV
2419
2420=item prefix_pattern
2421
2422A Perl pattern that identifies the strings that introduce options.
554627f6
RGS
2423Default is C<--|-|\+> unless environment variable
2424POSIXLY_CORRECT has been set, in which case it is C<--|->.
2425
2426=item long_prefix_pattern
2427
2428A Perl pattern that allows the disambiguation of long and short
2429prefixes. Default is C<-->.
2430
2431Typically you only need to set this if you are using nonstandard
2432prefixes and want some or all of them to have the same semantics as
2433'--' does under normal circumstances.
2434
2435For example, setting prefix_pattern to C<--|-|\+|\/> and
2436long_prefix_pattern to C<--|\/> would add Win32 style argument
2437handling.
3a0431da 2438
10e5c9cc 2439=item debug (default: disabled)
a0d0e21e 2440
10e5c9cc 2441Enable debugging output.
a0d0e21e 2442
bb40d378 2443=back
a0d0e21e 2444
10933be5
RGS
2445=head1 Exportable Methods
2446
2447=over
2448
2449=item VersionMessage
2450
2451This subroutine provides a standard version message. Its argument can be:
2452
2453=over 4
2454
2455=item *
2456
2457A string containing the text of a message to print I<before> printing
2458the standard message.
2459
2460=item *
2461
2462A numeric value corresponding to the desired exit status.
2463
2464=item *
2465
2466A reference to a hash.
2467
2468=back
2469
2470If more than one argument is given then the entire argument list is
2471assumed to be a hash. If a hash is supplied (either as a reference or
2472as a list) it should contain one or more elements with the following
2473keys:
2474
2475=over 4
2476
2477=item C<-message>
2478
2479=item C<-msg>
2480
2481The text of a message to print immediately prior to printing the
2482program's usage message.
2483
2484=item C<-exitval>
2485
2486The desired exit status to pass to the B<exit()> function.
2487This should be an integer, or else the string "NOEXIT" to
2488indicate that control should simply be returned without
2489terminating the invoking process.
2490
2491=item C<-output>
2492
2493A reference to a filehandle, or the pathname of a file to which the
2494usage message should be written. The default is C<\*STDERR> unless the
2495exit value is less than 2 (in which case the default is C<\*STDOUT>).
2496
2497=back
2498
2499You cannot tie this routine directly to an option, e.g.:
2500
2501 GetOptions("version" => \&VersionMessage);
2502
2503Use this instead:
2504
2505 GetOptions("version" => sub { VersionMessage() });
2506
2507=item HelpMessage
2508
2509This subroutine produces a standard help message, derived from the
79d0183a 2510program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
10933be5
RGS
2511arguments as VersionMessage(). In particular, you cannot tie it
2512directly to an option, e.g.:
2513
2514 GetOptions("help" => \&HelpMessage);
2515
2516Use this instead:
2517
2518 GetOptions("help" => sub { HelpMessage() });
2519
2520=back
2521
0b7031a2 2522=head1 Return values and Errors
381319f7 2523
0b7031a2
GS
2524Configuration errors and errors in the option definitions are
2525signalled using die() and will terminate the calling program unless
2526the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
2527}>, or die() was trapped using C<$SIG{__DIE__}>.
a0d0e21e 2528
10e5c9cc
JH
2529GetOptions returns true to indicate success.
2530It returns false when the function detected one or more errors during
2531option parsing. These errors are signalled using warn() and can be
2532trapped with C<$SIG{__WARN__}>.
a0d0e21e 2533
0b7031a2 2534=head1 Legacy
a0d0e21e 2535
0b7031a2
GS
2536The earliest development of C<newgetopt.pl> started in 1990, with Perl
2537version 4. As a result, its development, and the development of
2538Getopt::Long, has gone through several stages. Since backward
2539compatibility has always been extremely important, the current version
2540of Getopt::Long still supports a lot of constructs that nowadays are
2541no longer necessary or otherwise unwanted. This section describes
2542briefly some of these 'features'.
a0d0e21e 2543
0b7031a2 2544=head2 Default destinations
a0d0e21e 2545
0b7031a2
GS
2546When no destination is specified for an option, GetOptions will store
2547the resultant value in a global variable named C<opt_>I<XXX>, where
654bf526 2548I<XXX> is the primary name of this option. When a program executes
0b7031a2
GS
2549under C<use strict> (recommended), these variables must be
2550pre-declared with our() or C<use vars>.
2551
2552 our $opt_length = 0;
2553 GetOptions ('length=i'); # will store in $opt_length
2554
2555To yield a usable Perl variable, characters that are not part of the
2556syntax for variables are translated to underscores. For example,
2557C<--fpp-struct-return> will set the variable
2558C<$opt_fpp_struct_return>. Note that this variable resides in the
2559namespace of the calling program, not necessarily C<main>. For
2560example:
2561
2562 GetOptions ("size=i", "sizes=i@");
2563
2564with command line "-size 10 -sizes 24 -sizes 48" will perform the
2565equivalent of the assignments
2566
2567 $opt_size = 10;
2568 @opt_sizes = (24, 48);
2569
2570=head2 Alternative option starters
2571
2572A string of alternative option starter characters may be passed as the
2573first argument (or the first argument after a leading hash reference
2574argument).
2575
2576 my $len = 0;
2577 GetOptions ('/', 'length=i' => $len);
2578
2579Now the command line may look like:
2580
2581 /length 24 -- arg
2582
2583Note that to terminate options processing still requires a double dash
2584C<-->.
2585
10e5c9cc
JH
2586GetOptions() will not interpret a leading C<< "<>" >> as option starters
2587if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
2588option starters, use C<< "><" >>. Confusing? Well, B<using a starter
0b7031a2
GS
2589argument is strongly deprecated> anyway.
2590
2591=head2 Configuration variables
2592
2593Previous versions of Getopt::Long used variables for the purpose of
10e5c9cc
JH
2594configuring. Although manipulating these variables still work, it is
2595strongly encouraged to use the C<Configure> routine that was introduced
2596in version 2.17. Besides, it is much easier.
2597
8de02997
RGS
2598=head1 Tips and Techniques
2599
2600=head2 Pushing multiple values in a hash option
2601
2602Sometimes you want to combine the best of hashes and arrays. For
2603example, the command line:
2604
2605 --list add=first --list add=second --list add=third
2606
2607where each successive 'list add' option will push the value of add
2608into array ref $list->{'add'}. The result would be like
2609
2610 $list->{add} = [qw(first second third)];
2611
2612This can be accomplished with a destination routine:
2613
2614 GetOptions('list=s%' =>
2615 sub { push(@{$list{$_[1]}}, $_[2]) });
2616
a19443d4 2617=head1 Troubleshooting
10e5c9cc 2618
10e5c9cc
JH
2619=head2 GetOptions does not return a false result when an option is not supplied
2620
2621That's why they're called 'options'.
a0d0e21e 2622
2d08fc49
JH
2623=head2 GetOptions does not split the command line correctly
2624
2625The command line is not split by GetOptions, but by the command line
2626interpreter (CLI). On Unix, this is the shell. On Windows, it is
79d0183a 2627COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
2d08fc49
JH
2628
2629It is important to know that these CLIs may behave different when the
2630command line contains special characters, in particular quotes or
2631backslashes. For example, with Unix shells you can use single quotes
2632(C<'>) and double quotes (C<">) to group words together. The following
2633alternatives are equivalent on Unix:
2634
2635 "two words"
2636 'two words'
2637 two\ words
2638
2639In case of doubt, insert the following statement in front of your Perl
2640program:
2641
2642 print STDERR (join("|",@ARGV),"\n");
2643
2644to verify how your CLI passes the arguments to the program.
2645
10933be5
RGS
2646=head2 Undefined subroutine &main::GetOptions called
2647
2648Are you running Windows, and did you write
2649
2650 use GetOpt::Long;
2651
2652(note the capital 'O')?
2653
2d08fc49
JH
2654=head2 How do I put a "-?" option into a Getopt::Long?
2655
2656You can only obtain this using an alias, and Getopt::Long of at least
2657version 2.13.
2658
2659 use Getopt::Long;
2660 GetOptions ("help|?"); # -help and -? will both set $opt_help
2661
cdac3961
CBW
2662Other characters that can't appear in Perl identifiers are also supported
2663as aliases with Getopt::Long of at least version 2.39.
2664
2665As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
2666to add the options --help and -? to your program, and handle them.
2667
2668See C<auto_help> in section L<Configuring Getopt::Long>.
2669
bb40d378 2670=head1 AUTHOR
a11f5414 2671
10e5c9cc 2672Johan Vromans <jvromans@squirrel.nl>
a11f5414 2673
bb40d378 2674=head1 COPYRIGHT AND DISCLAIMER
a11f5414 2675
654bf526 2676This program is Copyright 1990,2013 by Johan Vromans.
bb40d378 2677This program is free software; you can redistribute it and/or
1a505819
GS
2678modify it under the terms of the Perl Artistic License or the
2679GNU General Public License as published by the Free Software
2680Foundation; either version 2 of the License, or (at your option) any
2681later version.
a11f5414 2682
bb40d378
JV
2683This program is distributed in the hope that it will be useful,
2684but WITHOUT ANY WARRANTY; without even the implied warranty of
2685MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2686GNU General Public License for more details.
a0d0e21e 2687
bb40d378 2688If you do not have a copy of the GNU General Public License write to
10e5c9cc 2689the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
f9a400e4 2690MA 02139, USA.
a0d0e21e 2691
bb40d378 2692=cut
0b7031a2 2693