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