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