This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Getopt::Long 2.36
[perl5.git] / lib / Getopt / Long.pm
CommitLineData
10933be5 1# Getopt::Long.pm -- Universal options parsing
404cbe93 2
a11f5414
JV
3package Getopt::Long;
4
8de02997 5# RCS Status : $Id: Long.pm,v 2.73 2007/01/27 20:00:34 jv Exp $
404cbe93
PP
6# Author : Johan Vromans
7# Created On : Tue Sep 11 15:00:12 1990
8# Last Modified By: Johan Vromans
8de02997
RGS
9# Last Modified On: Sat Jan 27 20:59:00 2007
10# Update Count : 1552
404cbe93
PP
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);
8de02997 38$VERSION = 2.36;
7d1b667f 39# For testing versions only.
8de02997
RGS
40use vars qw($VERSION_STRING);
41$VERSION_STRING = "2.36";
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 (",
8de02997 308 '$Revision: 2.73 $', ") ",
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
JH
1057 if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
1058 return (1, $opt, $ctl, $type eq 's' ? '' : 0) unless $mand;
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.
2d08fc49 1067 if ( $mand ) {
e6d5c530 1068 return (0) if $passthrough;
bb40d378
JV
1069 warn ("Option ", $opt, " requires an argument\n");
1070 $error++;
2d08fc49 1071 return (1, undef);
bb40d378 1072 }
bd444ebb
JH
1073 if ( $type eq 'I' ) {
1074 # Fake incremental type.
1075 my @c = @$ctl;
1076 $c[CTL_TYPE] = '+';
1077 return (1, $opt, \@c, 1);
1078 }
1079 return (1, $opt, $ctl,
1080 defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1081 $type eq 's' ? '' : 0);
bb40d378
JV
1082 }
1083
1084 # Get (possibly optional) argument.
1085 $arg = (defined $rest ? $rest
8de02997 1086 : (defined $optarg ? $optarg : shift (@$argv)));
bb40d378
JV
1087
1088 # Get key if this is a "name=value" pair for a hash option.
2d08fc49
JH
1089 my $key;
1090 if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
18172392 1091 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
10933be5
RGS
1092 : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1093 ($mand ? undef : ($type eq 's' ? "" : 1)));
1094 if (! defined $arg) {
1095 warn ("Option $opt, key \"$key\", requires a value\n");
1096 $error++;
1097 # Push back.
8de02997 1098 unshift (@$argv, $starter.$rest) if defined $rest;
10933be5
RGS
1099 return (1, undef);
1100 }
bb40d378
JV
1101 }
1102
1103 #### Check if the argument is valid for this option ####
1104
10933be5
RGS
1105 my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
1106
bd444ebb 1107 if ( $type eq 's' ) { # string
0b7031a2 1108 # A mandatory string takes anything.
2d08fc49 1109 return (1, $opt, $ctl, $arg, $key) if $mand;
bb40d378 1110
8de02997
RGS
1111 # Same for optional string as a hash value
1112 return (1, $opt, $ctl, $arg, $key)
1113 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
1114
0b7031a2 1115 # An optional string takes almost anything.
2d08fc49 1116 return (1, $opt, $ctl, $arg, $key)
e6d5c530 1117 if defined $optarg || defined $rest;
2d08fc49 1118 return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
bb40d378
JV
1119
1120 # Check for option or option list terminator.
1121 if ($arg eq $argend ||
e6d5c530 1122 $arg =~ /^$prefix.+/) {
bb40d378 1123 # Push back.
8de02997 1124 unshift (@$argv, $arg);
bb40d378
JV
1125 # Supply empty value.
1126 $arg = '';
1127 }
1128 }
1129
bd444ebb
JH
1130 elsif ( $type eq 'i' # numeric/integer
1131 || $type eq 'I' # numeric/integer w/ incr default
1132 || $type eq 'o' ) { # dec/oct/hex/bin value
7d1b667f 1133
8de02997 1134 my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
7d1b667f 1135
10933be5
RGS
1136 if ( $bundling && defined $rest
1137 && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
1138 ($key, $arg, $rest) = ($1, $2, $+);
1139 chop($key) if $key;
bd444ebb 1140 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
8de02997 1141 unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
bb40d378 1142 }
8de02997
RGS
1143 elsif ( $arg =~ /^$o_valid$/si ) {
1144 $arg =~ tr/_//d;
bd444ebb 1145 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
7d1b667f
JH
1146 }
1147 else {
2d08fc49 1148 if ( defined $optarg || $mand ) {
bb40d378 1149 if ( $passthrough ) {
8de02997 1150 unshift (@$argv, defined $rest ? $starter.$rest : $arg)
bb40d378 1151 unless defined $optarg;
e6d5c530 1152 return (0);
bb40d378
JV
1153 }
1154 warn ("Value \"", $arg, "\" invalid for option ",
7d1b667f 1155 $opt, " (",
bd444ebb 1156 $type eq 'o' ? "extended " : '',
7d1b667f 1157 "number expected)\n");
bb40d378 1158 $error++;
bb40d378 1159 # Push back.
8de02997 1160 unshift (@$argv, $starter.$rest) if defined $rest;
2d08fc49 1161 return (1, undef);
bb40d378
JV
1162 }
1163 else {
1164 # Push back.
8de02997 1165 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
bd444ebb
JH
1166 if ( $type eq 'I' ) {
1167 # Fake incremental type.
1168 my @c = @$ctl;
1169 $c[CTL_TYPE] = '+';
1170 return (1, $opt, \@c, 1);
1171 }
bb40d378 1172 # Supply default value.
bd444ebb 1173 $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
bb40d378
JV
1174 }
1175 }
1176 }
1177
bd444ebb 1178 elsif ( $type eq 'f' ) { # real number, int is also ok
bb40d378
JV
1179 # We require at least one digit before a point or 'e',
1180 # and at least one digit following the point and 'e'.
1181 # [-]NN[.NN][eNN]
8de02997 1182 my $o_valid = PAT_FLOAT;
bb40d378 1183 if ( $bundling && defined $rest &&
8de02997
RGS
1184 $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
1185 $arg =~ tr/_//d;
10933be5
RGS
1186 ($key, $arg, $rest) = ($1, $2, $+);
1187 chop($key) if $key;
8de02997 1188 unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
bb40d378 1189 }
8de02997
RGS
1190 elsif ( $arg =~ /^$o_valid$/ ) {
1191 $arg =~ tr/_//d;
1192 }
1193 else {
2d08fc49 1194 if ( defined $optarg || $mand ) {
bb40d378 1195 if ( $passthrough ) {
8de02997 1196 unshift (@$argv, defined $rest ? $starter.$rest : $arg)
bb40d378 1197 unless defined $optarg;
e6d5c530 1198 return (0);
bb40d378
JV
1199 }
1200 warn ("Value \"", $arg, "\" invalid for option ",
1201 $opt, " (real number expected)\n");
1202 $error++;
bb40d378 1203 # Push back.
8de02997 1204 unshift (@$argv, $starter.$rest) if defined $rest;
2d08fc49 1205 return (1, undef);
bb40d378
JV
1206 }
1207 else {
1208 # Push back.
8de02997 1209 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
bb40d378
JV
1210 # Supply default value.
1211 $arg = 0.0;
1212 }
1213 }
1214 }
1215 else {
10933be5 1216 die("Getopt::Long internal error (Can't happen)\n");
bb40d378 1217 }
2d08fc49 1218 return (1, $opt, $ctl, $arg, $key);
e6d5c530 1219}
bb40d378 1220
d4ad7505
RGS
1221sub ValidValue ($$$$$) {
1222 my ($ctl, $arg, $mand, $argend, $prefix) = @_;
1223
1224 if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
1225 return 0 unless $arg =~ /[^=]+=(.*)/;
1226 $arg = $1;
1227 }
1228
1229 my $type = $ctl->[CTL_TYPE];
1230
1231 if ( $type eq 's' ) { # string
1232 # A mandatory string takes anything.
1233 return (1) if $mand;
1234
1235 return (1) if $arg eq "-";
1236
1237 # Check for option or option list terminator.
1238 return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
1239 return 1;
1240 }
1241
1242 elsif ( $type eq 'i' # numeric/integer
1243 || $type eq 'I' # numeric/integer w/ incr default
1244 || $type eq 'o' ) { # dec/oct/hex/bin value
1245
8de02997 1246 my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
d4ad7505
RGS
1247 return $arg =~ /^$o_valid$/si;
1248 }
1249
1250 elsif ( $type eq 'f' ) { # real number, int is also ok
1251 # We require at least one digit before a point or 'e',
1252 # and at least one digit following the point and 'e'.
1253 # [-]NN[.NN][eNN]
8de02997
RGS
1254 my $o_valid = PAT_FLOAT;
1255 return $arg =~ /^$o_valid$/;
d4ad7505
RGS
1256 }
1257 die("ValidValue: Cannot happen\n");
1258}
1259
e6d5c530
JV
1260# Getopt::Long Configuration.
1261sub Configure (@) {
1262 my (@options) = @_;
0b7031a2
GS
1263
1264 my $prevconfig =
1265 [ $error, $debug, $major_version, $minor_version,
1266 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
554627f6
RGS
1267 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1268 $longprefix ];
0b7031a2
GS
1269
1270 if ( ref($options[0]) eq 'ARRAY' ) {
1271 ( $error, $debug, $major_version, $minor_version,
1272 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
554627f6
RGS
1273 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1274 $longprefix ) = @{shift(@options)};
0b7031a2
GS
1275 }
1276
e6d5c530
JV
1277 my $opt;
1278 foreach $opt ( @options ) {
1279 my $try = lc ($opt);
1280 my $action = 1;
1281 if ( $try =~ /^no_?(.*)$/s ) {
1282 $action = 0;
1283 $try = $+;
1284 }
10e5c9cc
JH
1285 if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
1286 ConfigDefaults ();
1287 }
1288 elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
1289 local $ENV{POSIXLY_CORRECT};
1290 $ENV{POSIXLY_CORRECT} = 1 if $action;
1291 ConfigDefaults ();
e6d5c530
JV
1292 }
1293 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
1294 $autoabbrev = $action;
1295 }
1296 elsif ( $try eq 'getopt_compat' ) {
1297 $getopt_compat = $action;
70e28ff3 1298 $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
e6d5c530 1299 }
10e5c9cc
JH
1300 elsif ( $try eq 'gnu_getopt' ) {
1301 if ( $action ) {
1302 $gnu_compat = 1;
1303 $bundling = 1;
1304 $getopt_compat = 0;
70e28ff3 1305 $genprefix = "(--|-)";
2d08fc49 1306 $order = $PERMUTE;
10e5c9cc
JH
1307 }
1308 }
1309 elsif ( $try eq 'gnu_compat' ) {
1310 $gnu_compat = $action;
1311 }
10933be5
RGS
1312 elsif ( $try =~ /^(auto_?)?version$/ ) {
1313 $auto_version = $action;
1314 }
1315 elsif ( $try =~ /^(auto_?)?help$/ ) {
1316 $auto_help = $action;
1317 }
e6d5c530
JV
1318 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
1319 $ignorecase = $action;
1320 }
8de02997 1321 elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
e6d5c530
JV
1322 $ignorecase = $action ? 2 : 0;
1323 }
1324 elsif ( $try eq 'bundling' ) {
1325 $bundling = $action;
1326 }
1327 elsif ( $try eq 'bundling_override' ) {
1328 $bundling = $action ? 2 : 0;
1329 }
1330 elsif ( $try eq 'require_order' ) {
1331 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
1332 }
1333 elsif ( $try eq 'permute' ) {
1334 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
1335 }
1336 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
1337 $passthrough = $action;
1338 }
10e5c9cc 1339 elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
e6d5c530
JV
1340 $genprefix = $1;
1341 # Turn into regexp. Needs to be parenthesized!
1342 $genprefix = "(" . quotemeta($genprefix) . ")";
1343 eval { '' =~ /$genprefix/; };
eab822e5 1344 die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
e6d5c530 1345 }
10e5c9cc 1346 elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
e6d5c530
JV
1347 $genprefix = $1;
1348 # Parenthesize if needed.
0b7031a2 1349 $genprefix = "(" . $genprefix . ")"
e6d5c530 1350 unless $genprefix =~ /^\(.*\)$/;
554627f6 1351 eval { '' =~ m"$genprefix"; };
eab822e5 1352 die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
e6d5c530 1353 }
554627f6
RGS
1354 elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
1355 $longprefix = $1;
1356 # Parenthesize if needed.
1357 $longprefix = "(" . $longprefix . ")"
1358 unless $longprefix =~ /^\(.*\)$/;
1359 eval { '' =~ m"$longprefix"; };
1360 die("Getopt::Long: invalid long prefix pattern \"$longprefix\"") if $@;
1361 }
e6d5c530
JV
1362 elsif ( $try eq 'debug' ) {
1363 $debug = $action;
1364 }
1365 else {
eab822e5 1366 die("Getopt::Long: unknown config parameter \"$opt\"")
e6d5c530 1367 }
bb40d378 1368 }
0b7031a2 1369 $prevconfig;
e6d5c530 1370}
bb40d378 1371
e6d5c530
JV
1372# Deprecated name.
1373sub config (@) {
1374 Configure (@_);
1375}
bb40d378 1376
10933be5
RGS
1377# Issue a standard message for --version.
1378#
1379# The arguments are mostly the same as for Pod::Usage::pod2usage:
1380#
1381# - a number (exit value)
1382# - a string (lead in message)
1383# - a hash with options. See Pod::Usage for details.
1384#
1385sub VersionMessage(@) {
1386 # Massage args.
1387 my $pa = setup_pa_args("version", @_);
1388
1389 my $v = $main::VERSION;
1390 my $fh = $pa->{-output} ||
1391 ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
1392
1393 print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
1394 $0, defined $v ? " version $v" : (),
1395 "\n",
1396 "(", __PACKAGE__, "::", "GetOptions",
1397 " version ",
79d0183a
RGS
1398 defined($Getopt::Long::VERSION_STRING)
1399 ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
10933be5
RGS
1400 " Perl version ",
1401 $] >= 5.006 ? sprintf("%vd", $^V) : $],
1402 ")\n");
1403 exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
1404}
1405
1406# Issue a standard message for --help.
1407#
1408# The arguments are the same as for Pod::Usage::pod2usage:
1409#
1410# - a number (exit value)
1411# - a string (lead in message)
1412# - a hash with options. See Pod::Usage for details.
1413#
1414sub HelpMessage(@) {
1415 eval {
1416 require Pod::Usage;
1417 import Pod::Usage;
1418 1;
1419 } || die("Cannot provide help: cannot load Pod::Usage\n");
1420
1421 # Note that pod2usage will issue a warning if -exitval => NOEXIT.
1422 pod2usage(setup_pa_args("help", @_));
1423
1424}
1425
1426# Helper routine to set up a normalized hash ref to be used as
1427# argument to pod2usage.
1428sub setup_pa_args($@) {
1429 my $tag = shift; # who's calling
1430
1431 # If called by direct binding to an option, it will get the option
1432 # name and value as arguments. Remove these, if so.
1433 @_ = () if @_ == 2 && $_[0] eq $tag;
1434
1435 my $pa;
1436 if ( @_ > 1 ) {
1437 $pa = { @_ };
1438 }
1439 else {
1440 $pa = shift || {};
1441 }
1442
1443 # At this point, $pa can be a number (exit value), string
1444 # (message) or hash with options.
1445
1446 if ( UNIVERSAL::isa($pa, 'HASH') ) {
1447 # Get rid of -msg vs. -message ambiguity.
1448 $pa->{-message} = $pa->{-msg};
1449 delete($pa->{-msg});
1450 }
1451 elsif ( $pa =~ /^-?\d+$/ ) {
1452 $pa = { -exitval => $pa };
1453 }
1454 else {
1455 $pa = { -message => $pa };
1456 }
1457
1458 # These are _our_ defaults.
1459 $pa->{-verbose} = 0 unless exists($pa->{-verbose});
1460 $pa->{-exitval} = 0 unless exists($pa->{-exitval});
1461 $pa;
1462}
1463
1464# Sneak way to know what version the user requested.
1465sub VERSION {
1466 $requested_version = $_[1];
1467 shift->SUPER::VERSION(@_);
1468}
1469
8de02997
RGS
1470package Getopt::Long::CallBack;
1471
1472sub new {
1473 my ($pkg, %atts) = @_;
1474 bless { %atts }, $pkg;
1475}
1476
1477sub name {
1478 my $self = shift;
1479 ''.$self->{name};
1480}
1481
1482use overload
1483 # Treat this object as an oridinary string for legacy API.
1484 '""' => \&name,
1485 '0+' => sub { 0 },
1486 fallback => 1;
1487
10933be5
RGS
14881;
1489
e6d5c530 1490################ Documentation ################
bb40d378
JV
1491
1492=head1 NAME
1493
0b7031a2 1494Getopt::Long - Extended processing of command line options
bb40d378
JV
1495
1496=head1 SYNOPSIS
1497
1498 use Getopt::Long;
7d1b667f
JH
1499 my $data = "file.dat";
1500 my $length = 24;
1501 my $verbose;
1502 $result = GetOptions ("length=i" => \$length, # numeric
1503 "file=s" => \$data, # string
1504 "verbose" => \$verbose); # flag
bb40d378
JV
1505
1506=head1 DESCRIPTION
1507
1508The Getopt::Long module implements an extended getopt function called
1509GetOptions(). This function adheres to the POSIX syntax for command
1510line options, with GNU extensions. In general, this means that options
1511have long names instead of single letters, and are introduced with a
1512double dash "--". Support for bundling of command line options, as was
1513the case with the more traditional single-letter approach, is provided
0b7031a2
GS
1514but not enabled by default.
1515
1516=head1 Command Line Options, an Introduction
1517
1518Command line operated programs traditionally take their arguments from
1519the command line, for example filenames or other information that the
1520program needs to know. Besides arguments, these programs often take
1521command line I<options> as well. Options are not necessary for the
1522program to work, hence the name 'option', but are used to modify its
1523default behaviour. For example, a program could do its job quietly,
1524but with a suitable option it could provide verbose information about
1525what it did.
1526
1527Command line options come in several flavours. Historically, they are
1528preceded by a single dash C<->, and consist of a single letter.
1529
1530 -l -a -c
1531
1532Usually, these single-character options can be bundled:
1533
1534 -lac
1535
1536Options can have values, the value is placed after the option
1537character. Sometimes with whitespace in between, sometimes not:
1538
1539 -s 24 -s24
1540
1541Due to the very cryptic nature of these options, another style was
1542developed that used long names. So instead of a cryptic C<-l> one
1543could use the more descriptive C<--long>. To distinguish between a
1544bundle of single-character options and a long one, two dashes are used
1545to precede the option name. Early implementations of long options used
1546a plus C<+> instead. Also, option values could be specified either
10e5c9cc 1547like
0b7031a2
GS
1548
1549 --size=24
1550
1551or
1552
1553 --size 24
1554
1555The C<+> form is now obsolete and strongly deprecated.
1556
1557=head1 Getting Started with Getopt::Long
1558
0613d572
SP
1559Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
1560first Perl module that provided support for handling the new style of
1561command line options, hence the name Getopt::Long. This module also
1562supports single-character options and bundling. Single character
1563options may be any alphabetic character, a question mark, and a dash.
1564Long options may consist of a series of letters, digits, and dashes.
1565Although this is currently not enforced by Getopt::Long, multiple
1566consecutive dashes are not allowed, and the option name must not end
1567with a dash.
0b7031a2
GS
1568
1569To use Getopt::Long from a Perl program, you must include the
1570following line in your Perl program:
1571
1572 use Getopt::Long;
1573
1574This will load the core of the Getopt::Long module and prepare your
1575program for using it. Most of the actual Getopt::Long code is not
1576loaded until you really call one of its functions.
1577
1578In the default configuration, options names may be abbreviated to
1579uniqueness, case does not matter, and a single dash is sufficient,
1580even for long option names. Also, options may be placed between
1581non-option arguments. See L<Configuring Getopt::Long> for more
1582details on how to configure Getopt::Long.
1583
1584=head2 Simple options
1585
1586The most simple options are the ones that take no values. Their mere
1587presence on the command line enables the option. Popular examples are:
1588
1589 --all --verbose --quiet --debug
1590
1591Handling simple options is straightforward:
1592
1593 my $verbose = ''; # option variable with default value (false)
1594 my $all = ''; # option variable with default value (false)
1595 GetOptions ('verbose' => \$verbose, 'all' => \$all);
1596
1597The call to GetOptions() parses the command line arguments that are
1598present in C<@ARGV> and sets the option variable to the value C<1> if
1599the option did occur on the command line. Otherwise, the option
1600variable is not touched. Setting the option value to true is often
1601called I<enabling> the option.
1602
1603The option name as specified to the GetOptions() function is called
1604the option I<specification>. Later we'll see that this specification
1605can contain more than just the option name. The reference to the
1606variable is called the option I<destination>.
1607
1608GetOptions() will return a true value if the command line could be
1609processed successfully. Otherwise, it will write error messages to
1610STDERR, and return a false result.
1611
1612=head2 A little bit less simple options
1613
1614Getopt::Long supports two useful variants of simple options:
1615I<negatable> options and I<incremental> options.
1616
d1be9408 1617A negatable option is specified with an exclamation mark C<!> after the
0b7031a2
GS
1618option name:
1619
1620 my $verbose = ''; # option variable with default value (false)
1621 GetOptions ('verbose!' => \$verbose);
1622
1623Now, using C<--verbose> on the command line will enable C<$verbose>,
1624as expected. But it is also allowed to use C<--noverbose>, which will
1625disable C<$verbose> by setting its value to C<0>. Using a suitable
1626default value, the program can find out whether C<$verbose> is false
1627by default, or disabled by using C<--noverbose>.
1628
1629An incremental option is specified with a plus C<+> after the
1630option name:
1631
1632 my $verbose = ''; # option variable with default value (false)
1633 GetOptions ('verbose+' => \$verbose);
1634
1635Using C<--verbose> on the command line will increment the value of
1636C<$verbose>. This way the program can keep track of how many times the
1637option occurred on the command line. For example, each occurrence of
1638C<--verbose> could increase the verbosity level of the program.
1639
1640=head2 Mixing command line option with other arguments
1641
1642Usually programs take command line options as well as other arguments,
1643for example, file names. It is good practice to always specify the
1644options first, and the other arguments last. Getopt::Long will,
1645however, allow the options and arguments to be mixed and 'filter out'
1646all the options before passing the rest of the arguments to the
1647program. To stop Getopt::Long from processing further arguments,
1648insert a double dash C<--> on the command line:
1649
1650 --size 24 -- --all
1651
1652In this example, C<--all> will I<not> be treated as an option, but
1653passed to the program unharmed, in C<@ARGV>.
1654
1655=head2 Options with values
1656
1657For options that take values it must be specified whether the option
1658value is required or not, and what kind of value the option expects.
1659
1660Three kinds of values are supported: integer numbers, floating point
1661numbers, and strings.
1662
1663If the option value is required, Getopt::Long will take the
1664command line argument that follows the option and assign this to the
1665option variable. If, however, the option value is specified as
1666optional, this will only be done if that value does not look like a
1667valid command line option itself.
bb40d378 1668
0b7031a2
GS
1669 my $tag = ''; # option variable with default value
1670 GetOptions ('tag=s' => \$tag);
bb40d378 1671
0b7031a2
GS
1672In the option specification, the option name is followed by an equals
1673sign C<=> and the letter C<s>. The equals sign indicates that this
1674option requires a value. The letter C<s> indicates that this value is
1675an arbitrary string. Other possible value types are C<i> for integer
1676values, and C<f> for floating point values. Using a colon C<:> instead
1677of the equals sign indicates that the option value is optional. In
1678this case, if no suitable value is supplied, string valued options get
1679an empty string C<''> assigned, while numeric options are set to C<0>.
bb40d378 1680
0b7031a2 1681=head2 Options with multiple values
bb40d378 1682
0b7031a2
GS
1683Options sometimes take several values. For example, a program could
1684use multiple directories to search for library files:
bb40d378 1685
0b7031a2 1686 --library lib/stdlib --library lib/extlib
bb40d378 1687
0b7031a2
GS
1688To accomplish this behaviour, simply specify an array reference as the
1689destination for the option:
bb40d378 1690
0b7031a2 1691 GetOptions ("library=s" => \@libfiles);
bb40d378 1692
9e01bed8
JH
1693Alternatively, you can specify that the option can have multiple
1694values by adding a "@", and pass a scalar reference as the
1695destination:
1696
1697 GetOptions ("library=s@" => \$libfiles);
1698
1699Used with the example above, C<@libfiles> (or C<@$libfiles>) would
1700contain two strings upon completion: C<"lib/srdlib"> and
1701C<"lib/extlib">, in that order. It is also possible to specify that
0613d572 1702only integer or floating point numbers are acceptable values.
bb40d378 1703
0b7031a2
GS
1704Often it is useful to allow comma-separated lists of values as well as
1705multiple occurrences of the options. This is easy using Perl's split()
1706and join() operators:
bb40d378 1707
0b7031a2
GS
1708 GetOptions ("library=s" => \@libfiles);
1709 @libfiles = split(/,/,join(',',@libfiles));
bb40d378 1710
0b7031a2
GS
1711Of course, it is important to choose the right separator string for
1712each purpose.
3cb6de81 1713
d4ad7505
RGS
1714Warning: What follows is an experimental feature.
1715
1716Options can take multiple values at once, for example
1717
1718 --coordinates 52.2 16.4 --rgbcolor 255 255 149
1719
1720This can be accomplished by adding a repeat specifier to the option
1721specification. Repeat specifiers are very similar to the C<{...}>
1722repeat specifiers that can be used with regular expression patterns.
1723For example, the above command line would be handled as follows:
1724
1725 GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
1726
1727The destination for the option must be an array or array reference.
1728
1729It is also possible to specify the minimal and maximal number of
1730arguments an option takes. C<foo=s{2,4}> indicates an option that
1731takes at least two and at most 4 arguments. C<foo=s{,}> indicates one
1732or more values; C<foo:s{,}> indicates zero or more option values.
1733
0b7031a2 1734=head2 Options with hash values
bb40d378 1735
0b7031a2
GS
1736If the option destination is a reference to a hash, the option will
1737take, as value, strings of the form I<key>C<=>I<value>. The value will
1738be stored with the specified key in the hash.
bb40d378 1739
0b7031a2 1740 GetOptions ("define=s" => \%defines);
bb40d378 1741
9e01bed8
JH
1742Alternatively you can use:
1743
1744 GetOptions ("define=s%" => \$defines);
1745
0b7031a2
GS
1746When used with command line options:
1747
1748 --define os=linux --define vendor=redhat
1749
9e01bed8
JH
1750the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
1751with value C<"linux> and C<"vendor"> with value C<"redhat">. It is
1752also possible to specify that only integer or floating point numbers
0613d572 1753are acceptable values. The keys are always taken to be strings.
0b7031a2
GS
1754
1755=head2 User-defined subroutines to handle options
1756
1757Ultimate control over what should be done when (actually: each time)
1758an option is encountered on the command line can be achieved by
1759designating a reference to a subroutine (or an anonymous subroutine)
1760as the option destination. When GetOptions() encounters the option, it
2d08fc49
JH
1761will call the subroutine with two or three arguments. The first
1762argument is the name of the option. For a scalar or array destination,
1763the second argument is the value to be stored. For a hash destination,
1764the second arguments is the key to the hash, and the third argument
1765the value to be stored. It is up to the subroutine to store the value,
1766or do whatever it thinks is appropriate.
0b7031a2
GS
1767
1768A trivial application of this mechanism is to implement options that
1769are related to each other. For example:
1770
1771 my $verbose = ''; # option variable with default value (false)
1772 GetOptions ('verbose' => \$verbose,
1773 'quiet' => sub { $verbose = 0 });
1774
1775Here C<--verbose> and C<--quiet> control the same variable
1776C<$verbose>, but with opposite values.
1777
1778If the subroutine needs to signal an error, it should call die() with
1779the desired error message as its argument. GetOptions() will catch the
1780die(), issue the error message, and record that an error result must
1781be returned upon completion.
1782
0613d572 1783If the text of the error message starts with an exclamation mark C<!>
bee0ef1e
GS
1784it is interpreted specially by GetOptions(). There is currently one
1785special command implemented: C<die("!FINISH")> will cause GetOptions()
1786to stop processing options, as if it encountered a double dash C<-->.
0b7031a2
GS
1787
1788=head2 Options with multiple names
1789
1790Often it is user friendly to supply alternate mnemonic names for
1791options. For example C<--height> could be an alternate name for
1792C<--length>. Alternate names can be included in the option
1793specification, separated by vertical bar C<|> characters. To implement
1794the above example:
1795
1796 GetOptions ('length|height=f' => \$length);
1797
1798The first name is called the I<primary> name, the other names are
554627f6
RGS
1799called I<aliases>. When using a hash to store options, the key will
1800always be the primary name.
0b7031a2
GS
1801
1802Multiple alternate names are possible.
1803
1804=head2 Case and abbreviations
1805
1806Without additional configuration, GetOptions() will ignore the case of
1807option names, and allow the options to be abbreviated to uniqueness.
1808
1809 GetOptions ('length|height=f' => \$length, "head" => \$head);
1810
1811This call will allow C<--l> and C<--L> for the length option, but
1812requires a least C<--hea> and C<--hei> for the head and height options.
1813
1814=head2 Summary of Option Specifications
1815
1816Each option specifier consists of two parts: the name specification
10e5c9cc 1817and the argument specification.
0b7031a2
GS
1818
1819The name specification contains the name of the option, optionally
1820followed by a list of alternative names separated by vertical bar
10e5c9cc 1821characters.
0b7031a2
GS
1822
1823 length option name is "length"
1824 length|size|l name is "length", aliases are "size" and "l"
1825
1826The argument specification is optional. If omitted, the option is
1827considered boolean, a value of 1 will be assigned when the option is
1828used on the command line.
1829
1830The argument specification can be
1831
bbc7dcd2 1832=over 4
bb40d378
JV
1833
1834=item !
1835
0613d572
SP
1836The option does not take an argument and may be negated by prefixing
1837it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
18381 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
18390 will be assigned). If the option has aliases, this applies to the
1840aliases as well.
265c41c2
GS
1841
1842Using negation on a single letter option when bundling is in effect is
1843pointless and will result in a warning.
bb40d378 1844
e6d5c530
JV
1845=item +
1846
0b7031a2
GS
1847The option does not take an argument and will be incremented by 1
1848every time it appears on the command line. E.g. C<"more+">, when used
1849with C<--more --more --more>, will increment the value three times,
1850resulting in a value of 3 (provided it was 0 or undefined at first).
e6d5c530 1851
0b7031a2 1852The C<+> specifier is ignored if the option destination is not a scalar.
e6d5c530 1853
d4ad7505 1854=item = I<type> [ I<desttype> ] [ I<repeat> ]
bb40d378 1855
0b7031a2
GS
1856The option requires an argument of the given type. Supported types
1857are:
bb40d378 1858
bbc7dcd2 1859=over 4
bb40d378 1860
0b7031a2 1861=item s
bb40d378 1862
0b7031a2
GS
1863String. An arbitrary sequence of characters. It is valid for the
1864argument to start with C<-> or C<-->.
bb40d378 1865
0b7031a2 1866=item i
bb40d378 1867
0b7031a2
GS
1868Integer. An optional leading plus or minus sign, followed by a
1869sequence of digits.
bb40d378 1870
7d1b667f
JH
1871=item o
1872
1873Extended integer, Perl style. This can be either an optional leading
1874plus or minus sign, followed by a sequence of digits, or an octal
1875string (a zero, optionally followed by '0', '1', .. '7'), or a
1876hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
1877insensitive), or a binary string (C<0b> followed by a series of '0'
1878and '1').
1879
0b7031a2 1880=item f
bb40d378 1881
0b7031a2 1882Real number. For example C<3.14>, C<-6.23E24> and so on.
bb40d378 1883
0b7031a2
GS
1884=back
1885
1886The I<desttype> can be C<@> or C<%> to specify that the option is
1887list or a hash valued. This is only needed when the destination for
1888the option value is not otherwise specified. It should be omitted when
1889not needed.
1890
d4ad7505
RGS
1891The I<repeat> specifies the number of values this option takes per
1892occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
1893
1894I<min> denotes the minimal number of arguments. It defaults to 1 for
1895options with C<=> and to 0 for options with C<:>, see below. Note that
1896I<min> overrules the C<=> / C<:> semantics.
1897
1898I<max> denotes the maximum number of arguments. It must be at least
1899I<min>. If I<max> is omitted, I<but the comma is not>, there is no
1900upper bound to the number of argument values taken.
1901
0b7031a2 1902=item : I<type> [ I<desttype> ]
404cbe93 1903
0b7031a2
GS
1904Like C<=>, but designates the argument as optional.
1905If omitted, an empty string will be assigned to string values options,
1906and the value zero to numeric options.
404cbe93 1907
0b7031a2
GS
1908Note that if a string argument starts with C<-> or C<-->, it will be
1909considered an option on itself.
404cbe93 1910
bd444ebb
JH
1911=item : I<number> [ I<desttype> ]
1912
1913Like C<:i>, but if the value is omitted, the I<number> will be assigned.
1914
1915=item : + [ I<desttype> ]
1916
1917Like C<:i>, but if the value is omitted, the current value for the
1918option will be incremented.
1919
404cbe93
PP
1920=back
1921
0b7031a2 1922=head1 Advanced Possibilities
404cbe93 1923
10e5c9cc
JH
1924=head2 Object oriented interface
1925
1926Getopt::Long can be used in an object oriented way as well:
1927
1928 use Getopt::Long;
1929 $p = new Getopt::Long::Parser;
1930 $p->configure(...configuration options...);
1931 if ($p->getoptions(...options descriptions...)) ...
1932
1933Configuration options can be passed to the constructor:
1934
1935 $p = new Getopt::Long::Parser
1936 config => [...configuration options...];
1937
18172392
JH
1938=head2 Thread Safety
1939
1940Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is
1941I<not> thread safe when using the older (experimental and now
1942obsolete) threads implementation that was added to Perl 5.005.
10e5c9cc 1943
0b7031a2 1944=head2 Documentation and help texts
404cbe93 1945
0b7031a2
GS
1946Getopt::Long encourages the use of Pod::Usage to produce help
1947messages. For example:
404cbe93 1948
0b7031a2
GS
1949 use Getopt::Long;
1950 use Pod::Usage;
404cbe93 1951
0b7031a2
GS
1952 my $man = 0;
1953 my $help = 0;
404cbe93 1954
0b7031a2
GS
1955 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1956 pod2usage(1) if $help;
1957 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
404cbe93 1958
0b7031a2 1959 __END__
404cbe93 1960
0b7031a2 1961 =head1 NAME
404cbe93 1962
10933be5 1963 sample - Using Getopt::Long and Pod::Usage
404cbe93 1964
0b7031a2 1965 =head1 SYNOPSIS
404cbe93 1966
0b7031a2 1967 sample [options] [file ...]
404cbe93 1968
0b7031a2
GS
1969 Options:
1970 -help brief help message
1971 -man full documentation
381319f7 1972
0b7031a2 1973 =head1 OPTIONS
381319f7 1974
0b7031a2 1975 =over 8
381319f7 1976
0b7031a2 1977 =item B<-help>
381319f7 1978
0b7031a2 1979 Print a brief help message and exits.
404cbe93 1980
0b7031a2 1981 =item B<-man>
404cbe93 1982
0b7031a2 1983 Prints the manual page and exits.
404cbe93 1984
0b7031a2 1985 =back
404cbe93 1986
0b7031a2 1987 =head1 DESCRIPTION
404cbe93 1988
db5d900a 1989 B<This program> will read the given input file(s) and do something
0b7031a2 1990 useful with the contents thereof.
404cbe93 1991
0b7031a2 1992 =cut
535b5725 1993
0b7031a2 1994See L<Pod::Usage> for details.
535b5725 1995
8de02997
RGS
1996=head2 Parsing options from an arbitrary array
1997
1998By default, GetOptions parses the options that are present in the
1999global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
2000used to parse options from an arbitrary array.
2001
2002 use Getopt::Long qw(GetOptionsFromArray);
2003 $ret = GetOptionsFromArray(\@myopts, ...);
2004
2005When used like this, the global C<@ARGV> is not touched at all.
2006
2007The following two calls behave identically:
2008
2009 $ret = GetOptions( ... );
2010 $ret = GetOptionsFromArray(\@ARGV, ... );
2011
2012=head2 Parsing options from an arbitrary string
2013
2014A special entry C<GetOptionsFromString> can be used to parse options
2015from an arbitrary string.
2016
2017 use Getopt::Long qw(GetOptionsFromString);
2018 $ret = GetOptionsFromString($string, ...);
2019
2020The contents of the string are split into arguments using a call to
2021C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
2022global C<@ARGV> is not touched.
2023
2024It is possible that, upon completion, not all arguments in the string
2025have been processed. C<GetOptionsFromString> will, when called in list
2026context, return both the return status and an array reference to any
2027remaining arguments:
2028
2029 ($ret, $args) = GetOptionsFromString($string, ... );
2030
2031If any arguments remain, and C<GetOptionsFromString> was not called in
2032list context, a message will be given and C<GetOptionsFromString> will
2033return failure.
2034
2035=head2 Storing options values in a hash
404cbe93 2036
0b7031a2
GS
2037Sometimes, for example when there are a lot of options, having a
2038separate variable for each of them can be cumbersome. GetOptions()
8de02997
RGS
2039supports, as an alternative mechanism, storing options values in a
2040hash.
404cbe93 2041
0b7031a2
GS
2042To obtain this, a reference to a hash must be passed I<as the first
2043argument> to GetOptions(). For each option that is specified on the
2044command line, the option value will be stored in the hash with the
2045option name as key. Options that are not actually used on the command
2046line will not be put in the hash, on other words,
2047C<exists($h{option})> (or defined()) can be used to test if an option
2048was used. The drawback is that warnings will be issued if the program
2049runs under C<use strict> and uses C<$h{option}> without testing with
2050exists() or defined() first.
381319f7 2051
0b7031a2
GS
2052 my %h = ();
2053 GetOptions (\%h, 'length=i'); # will store in $h{length}
f06db76b 2054
0b7031a2
GS
2055For options that take list or hash values, it is necessary to indicate
2056this by appending an C<@> or C<%> sign after the type:
f06db76b 2057
0b7031a2 2058 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
f06db76b 2059
0b7031a2
GS
2060To make things more complicated, the hash may contain references to
2061the actual destinations, for example:
f06db76b 2062
0b7031a2
GS
2063 my $len = 0;
2064 my %h = ('length' => \$len);
2065 GetOptions (\%h, 'length=i'); # will store in $len
f06db76b 2066
0b7031a2 2067This example is fully equivalent with:
a11f5414 2068
0b7031a2
GS
2069 my $len = 0;
2070 GetOptions ('length=i' => \$len); # will store in $len
f06db76b 2071
0b7031a2
GS
2072Any mixture is possible. For example, the most frequently used options
2073could be stored in variables while all other options get stored in the
2074hash:
f06db76b 2075
0b7031a2
GS
2076 my $verbose = 0; # frequently referred
2077 my $debug = 0; # frequently referred
2078 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
2079 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
2080 if ( $verbose ) { ... }
2081 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
f06db76b 2082
0b7031a2 2083=head2 Bundling
f06db76b 2084
0b7031a2
GS
2085With bundling it is possible to set several single-character options
2086at once. For example if C<a>, C<v> and C<x> are all valid options,
bb40d378 2087
0b7031a2 2088 -vax
bb40d378 2089
0b7031a2 2090would set all three.
f06db76b 2091
0b7031a2
GS
2092Getopt::Long supports two levels of bundling. To enable bundling, a
2093call to Getopt::Long::Configure is required.
bb40d378 2094
0b7031a2 2095The first level of bundling can be enabled with:
f06db76b 2096
0b7031a2 2097 Getopt::Long::Configure ("bundling");
404cbe93 2098
0b7031a2
GS
2099Configured this way, single-character options can be bundled but long
2100options B<must> always start with a double dash C<--> to avoid
0613d572 2101ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
0b7031a2 2102options,
404cbe93 2103
0b7031a2 2104 -vax
381319f7 2105
10e5c9cc 2106would set C<a>, C<v> and C<x>, but
404cbe93 2107
0b7031a2 2108 --vax
404cbe93 2109
0b7031a2 2110would set C<vax>.
a11f5414 2111
0b7031a2
GS
2112The second level of bundling lifts this restriction. It can be enabled
2113with:
a11f5414 2114
0b7031a2 2115 Getopt::Long::Configure ("bundling_override");
a11f5414 2116
0b7031a2 2117Now, C<-vax> would set the option C<vax>.
a11f5414 2118
0b7031a2
GS
2119When any level of bundling is enabled, option values may be inserted
2120in the bundle. For example:
381319f7 2121
0b7031a2 2122 -h24w80
f06db76b 2123
0b7031a2 2124is equivalent to
f06db76b 2125
0b7031a2 2126 -h 24 -w 80
f06db76b 2127
0b7031a2
GS
2128When configured for bundling, single-character options are matched
2129case sensitive while long options are matched case insensitive. To
2130have the single-character options matched case insensitive as well,
2131use:
a0d0e21e 2132
0b7031a2 2133 Getopt::Long::Configure ("bundling", "ignorecase_always");
a0d0e21e 2134
0b7031a2 2135It goes without saying that bundling can be quite confusing.
404cbe93 2136
0b7031a2 2137=head2 The lonesome dash
404cbe93 2138
ea071ac9
JH
2139Normally, a lone dash C<-> on the command line will not be considered
2140an option. Option processing will terminate (unless "permute" is
2141configured) and the dash will be left in C<@ARGV>.
2142
2143It is possible to get special treatment for a lone dash. This can be
2144achieved by adding an option specification with an empty name, for
2145example:
a0d0e21e 2146
0b7031a2 2147 GetOptions ('' => \$stdio);
a11f5414 2148
ea071ac9
JH
2149A lone dash on the command line will now be a legal option, and using
2150it will set variable C<$stdio>.
a0d0e21e 2151
2d08fc49 2152=head2 Argument callback
a0d0e21e 2153
10933be5 2154A special option 'name' C<< <> >> can be used to designate a subroutine
0b7031a2
GS
2155to handle non-option arguments. When GetOptions() encounters an
2156argument that does not look like an option, it will immediately call this
2d08fc49 2157subroutine and passes it one parameter: the argument name.
a0d0e21e 2158
0b7031a2 2159For example:
a0d0e21e 2160
0b7031a2
GS
2161 my $width = 80;
2162 sub process { ... }
2163 GetOptions ('width=i' => \$width, '<>' => \&process);
a0d0e21e 2164
0b7031a2 2165When applied to the following command line:
a11f5414 2166
0b7031a2 2167 arg1 --width=72 arg2 --width=60 arg3
404cbe93 2168
10e5c9cc
JH
2169This will call
2170C<process("arg1")> while C<$width> is C<80>,
0b7031a2
GS
2171C<process("arg2")> while C<$width> is C<72>, and
2172C<process("arg3")> while C<$width> is C<60>.
381319f7 2173
0b7031a2
GS
2174This feature requires configuration option B<permute>, see section
2175L<Configuring Getopt::Long>.
a0d0e21e 2176
0b7031a2
GS
2177=head1 Configuring Getopt::Long
2178
2179Getopt::Long can be configured by calling subroutine
2180Getopt::Long::Configure(). This subroutine takes a list of quoted
10e5c9cc
JH
2181strings, each specifying a configuration option to be enabled, e.g.
2182C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
0b7031a2 2183matter. Multiple calls to Configure() are possible.
404cbe93 2184
10e5c9cc
JH
2185Alternatively, as of version 2.24, the configuration options may be
2186passed together with the C<use> statement:
2187
2188 use Getopt::Long qw(:config no_ignore_case bundling);
2189
bb40d378 2190The following options are available:
404cbe93 2191
bb40d378 2192=over 12
a0d0e21e 2193
bb40d378 2194=item default
a0d0e21e 2195
bb40d378
JV
2196This option causes all configuration options to be reset to their
2197default values.
404cbe93 2198
10e5c9cc
JH
2199=item posix_default
2200
2201This option causes all configuration options to be reset to their
2202default values as if the environment variable POSIXLY_CORRECT had
2203been set.
2204
bb40d378 2205=item auto_abbrev
404cbe93 2206
bb40d378 2207Allow option names to be abbreviated to uniqueness.
10e5c9cc
JH
2208Default is enabled unless environment variable
2209POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
404cbe93 2210
0b7031a2 2211=item getopt_compat
a0d0e21e 2212
0b7031a2 2213Allow C<+> to start options.
10e5c9cc
JH
2214Default is enabled unless environment variable
2215POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
88e49c4e 2216
8ed53c8c
JH
2217=item gnu_compat
2218
2219C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
2220do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
2221C<--opt=> will give option C<opt> and empty value.
2222This is the way GNU getopt_long() does it.
2223
2224=item gnu_getopt
2225
2226This is a short way of setting C<gnu_compat> C<bundling> C<permute>
2227C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
2228fully compatible with GNU getopt_long().
2229
bb40d378 2230=item require_order
404cbe93 2231
0b7031a2 2232Whether command line arguments are allowed to be mixed with options.
10e5c9cc
JH
2233Default is disabled unless environment variable
2234POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
404cbe93 2235
0b7031a2 2236See also C<permute>, which is the opposite of C<require_order>.
a0d0e21e 2237
bb40d378 2238=item permute
404cbe93 2239
0b7031a2 2240Whether command line arguments are allowed to be mixed with options.
10e5c9cc
JH
2241Default is enabled unless environment variable
2242POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
0b7031a2 2243Note that C<permute> is the opposite of C<require_order>.
a0d0e21e 2244
10e5c9cc 2245If C<permute> is enabled, this means that
a0d0e21e 2246
0b7031a2 2247 --foo arg1 --bar arg2 arg3
a0d0e21e 2248
bb40d378 2249is equivalent to
a0d0e21e 2250
0b7031a2 2251 --foo --bar arg1 arg2 arg3
a0d0e21e 2252
2d08fc49 2253If an argument callback routine is specified, C<@ARGV> will always be
0613d572 2254empty upon successful return of GetOptions() since all options have been
0b7031a2 2255processed. The only exception is when C<--> is used:
a0d0e21e 2256
0b7031a2 2257 --foo arg1 --bar arg2 -- arg3
404cbe93 2258
2d08fc49
JH
2259This will call the callback routine for arg1 and arg2, and then
2260terminate GetOptions() leaving C<"arg2"> in C<@ARGV>.
381319f7 2261
10e5c9cc 2262If C<require_order> is enabled, options processing
bb40d378 2263terminates when the first non-option is encountered.
a0d0e21e 2264
0b7031a2 2265 --foo arg1 --bar arg2 arg3
381319f7 2266
bb40d378 2267is equivalent to
381319f7 2268
0b7031a2 2269 --foo -- arg1 --bar arg2 arg3
404cbe93 2270
ac634a9a
JH
2271If C<pass_through> is also enabled, options processing will terminate
2272at the first unrecognized option, or non-option, whichever comes
2273first.
2274
10e5c9cc 2275=item bundling (default: disabled)
404cbe93 2276
bd444ebb
JH
2277Enabling this option will allow single-character options to be
2278bundled. To distinguish bundles from long option names, long options
2279I<must> be introduced with C<--> and bundles with C<->.
2280
2281Note that, if you have options C<a>, C<l> and C<all>, and
2282auto_abbrev enabled, possible arguments and option settings are:
2283
2284 using argument sets option(s)
2285 ------------------------------------------
2286 -a, --a a
2287 -l, --l l
2288 -al, -la, -ala, -all,... a, l
2289 --al, --all all
2290
0613d572 2291The surprising part is that C<--a> sets option C<a> (due to auto
bd444ebb 2292completion), not C<all>.
bb40d378 2293
10e5c9cc 2294Note: disabling C<bundling> also disables C<bundling_override>.
a11f5414 2295
10e5c9cc 2296=item bundling_override (default: disabled)
381319f7 2297
10e5c9cc
JH
2298If C<bundling_override> is enabled, bundling is enabled as with
2299C<bundling> but now long option names override option bundles.
381319f7 2300
10e5c9cc 2301Note: disabling C<bundling_override> also disables C<bundling>.
381319f7 2302
bb40d378
JV
2303B<Note:> Using option bundling can easily lead to unexpected results,
2304especially when mixing long options and bundles. Caveat emptor.
381319f7 2305
10e5c9cc 2306=item ignore_case (default: enabled)
381319f7 2307
bd444ebb
JH
2308If enabled, case is ignored when matching long option names. If,
2309however, bundling is enabled as well, single character options will be
2310treated case-sensitive.
2311
2312With C<ignore_case>, option specifications for options that only
2313differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
2314duplicates.
381319f7 2315
10e5c9cc 2316Note: disabling C<ignore_case> also disables C<ignore_case_always>.
381319f7 2317
10e5c9cc 2318=item ignore_case_always (default: disabled)
a11f5414 2319
bb40d378 2320When bundling is in effect, case is ignored on single-character
10e5c9cc 2321options also.
381319f7 2322
10e5c9cc 2323Note: disabling C<ignore_case_always> also disables C<ignore_case>.
381319f7 2324
10933be5
RGS
2325=item auto_version (default:disabled)
2326
2327Automatically provide support for the B<--version> option if
2328the application did not specify a handler for this option itself.
2329
2330Getopt::Long will provide a standard version message that includes the
2331program name, its version (if $main::VERSION is defined), and the
2332versions of Getopt::Long and Perl. The message will be written to
2333standard output and processing will terminate.
2334
9e01bed8
JH
2335C<auto_version> will be enabled if the calling program explicitly
2336specified a version number higher than 2.32 in the C<use> or
2337C<require> statement.
2338
10933be5
RGS
2339=item auto_help (default:disabled)
2340
2341Automatically provide support for the B<--help> and B<-?> options if
2342the application did not specify a handler for this option itself.
2343
79d0183a 2344Getopt::Long will provide a help message using module L<Pod::Usage>. The
10933be5
RGS
2345message, derived from the SYNOPSIS POD section, will be written to
2346standard output and processing will terminate.
2347
9e01bed8
JH
2348C<auto_help> will be enabled if the calling program explicitly
2349specified a version number higher than 2.32 in the C<use> or
2350C<require> statement.
2351
10e5c9cc 2352=item pass_through (default: disabled)
a0d0e21e 2353
0b7031a2
GS
2354Options that are unknown, ambiguous or supplied with an invalid option
2355value are passed through in C<@ARGV> instead of being flagged as
2356errors. This makes it possible to write wrapper scripts that process
2357only part of the user supplied command line arguments, and pass the
bb40d378 2358remaining options to some other program.
a0d0e21e 2359
ac634a9a
JH
2360If C<require_order> is enabled, options processing will terminate at
2361the first unrecognized option, or non-option, whichever comes first.
2362However, if C<permute> is enabled instead, results can become confusing.
16c18a90 2363
10933be5
RGS
2364Note that the options terminator (default C<-->), if present, will
2365also be passed through in C<@ARGV>.
2366
3a0431da
JV
2367=item prefix
2368
0b7031a2
GS
2369The string that starts options. If a constant string is not
2370sufficient, see C<prefix_pattern>.
3a0431da
JV
2371
2372=item prefix_pattern
2373
2374A Perl pattern that identifies the strings that introduce options.
554627f6
RGS
2375Default is C<--|-|\+> unless environment variable
2376POSIXLY_CORRECT has been set, in which case it is C<--|->.
2377
2378=item long_prefix_pattern
2379
2380A Perl pattern that allows the disambiguation of long and short
2381prefixes. Default is C<-->.
2382
2383Typically you only need to set this if you are using nonstandard
2384prefixes and want some or all of them to have the same semantics as
2385'--' does under normal circumstances.
2386
2387For example, setting prefix_pattern to C<--|-|\+|\/> and
2388long_prefix_pattern to C<--|\/> would add Win32 style argument
2389handling.
3a0431da 2390
10e5c9cc 2391=item debug (default: disabled)
a0d0e21e 2392
10e5c9cc 2393Enable debugging output.
a0d0e21e 2394
bb40d378 2395=back
a0d0e21e 2396
10933be5
RGS
2397=head1 Exportable Methods
2398
2399=over
2400
2401=item VersionMessage
2402
2403This subroutine provides a standard version message. Its argument can be:
2404
2405=over 4
2406
2407=item *
2408
2409A string containing the text of a message to print I<before> printing
2410the standard message.
2411
2412=item *
2413
2414A numeric value corresponding to the desired exit status.
2415
2416=item *
2417
2418A reference to a hash.
2419
2420=back
2421
2422If more than one argument is given then the entire argument list is
2423assumed to be a hash. If a hash is supplied (either as a reference or
2424as a list) it should contain one or more elements with the following
2425keys:
2426
2427=over 4
2428
2429=item C<-message>
2430
2431=item C<-msg>
2432
2433The text of a message to print immediately prior to printing the
2434program's usage message.
2435
2436=item C<-exitval>
2437
2438The desired exit status to pass to the B<exit()> function.
2439This should be an integer, or else the string "NOEXIT" to
2440indicate that control should simply be returned without
2441terminating the invoking process.
2442
2443=item C<-output>
2444
2445A reference to a filehandle, or the pathname of a file to which the
2446usage message should be written. The default is C<\*STDERR> unless the
2447exit value is less than 2 (in which case the default is C<\*STDOUT>).
2448
2449=back
2450
2451You cannot tie this routine directly to an option, e.g.:
2452
2453 GetOptions("version" => \&VersionMessage);
2454
2455Use this instead:
2456
2457 GetOptions("version" => sub { VersionMessage() });
2458
2459=item HelpMessage
2460
2461This subroutine produces a standard help message, derived from the
79d0183a 2462program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
10933be5
RGS
2463arguments as VersionMessage(). In particular, you cannot tie it
2464directly to an option, e.g.:
2465
2466 GetOptions("help" => \&HelpMessage);
2467
2468Use this instead:
2469
2470 GetOptions("help" => sub { HelpMessage() });
2471
2472=back
2473
0b7031a2 2474=head1 Return values and Errors
381319f7 2475
0b7031a2
GS
2476Configuration errors and errors in the option definitions are
2477signalled using die() and will terminate the calling program unless
2478the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
2479}>, or die() was trapped using C<$SIG{__DIE__}>.
a0d0e21e 2480
10e5c9cc
JH
2481GetOptions returns true to indicate success.
2482It returns false when the function detected one or more errors during
2483option parsing. These errors are signalled using warn() and can be
2484trapped with C<$SIG{__WARN__}>.
a0d0e21e 2485
0b7031a2 2486=head1 Legacy
a0d0e21e 2487
0b7031a2
GS
2488The earliest development of C<newgetopt.pl> started in 1990, with Perl
2489version 4. As a result, its development, and the development of
2490Getopt::Long, has gone through several stages. Since backward
2491compatibility has always been extremely important, the current version
2492of Getopt::Long still supports a lot of constructs that nowadays are
2493no longer necessary or otherwise unwanted. This section describes
2494briefly some of these 'features'.
a0d0e21e 2495
0b7031a2 2496=head2 Default destinations
a0d0e21e 2497
0b7031a2
GS
2498When no destination is specified for an option, GetOptions will store
2499the resultant value in a global variable named C<opt_>I<XXX>, where
2500I<XXX> is the primary name of this option. When a progam executes
2501under C<use strict> (recommended), these variables must be
2502pre-declared with our() or C<use vars>.
2503
2504 our $opt_length = 0;
2505 GetOptions ('length=i'); # will store in $opt_length
2506
2507To yield a usable Perl variable, characters that are not part of the
2508syntax for variables are translated to underscores. For example,
2509C<--fpp-struct-return> will set the variable
2510C<$opt_fpp_struct_return>. Note that this variable resides in the
2511namespace of the calling program, not necessarily C<main>. For
2512example:
2513
2514 GetOptions ("size=i", "sizes=i@");
2515
2516with command line "-size 10 -sizes 24 -sizes 48" will perform the
2517equivalent of the assignments
2518
2519 $opt_size = 10;
2520 @opt_sizes = (24, 48);
2521
2522=head2 Alternative option starters
2523
2524A string of alternative option starter characters may be passed as the
2525first argument (or the first argument after a leading hash reference
2526argument).
2527
2528 my $len = 0;
2529 GetOptions ('/', 'length=i' => $len);
2530
2531Now the command line may look like:
2532
2533 /length 24 -- arg
2534
2535Note that to terminate options processing still requires a double dash
2536C<-->.
2537
10e5c9cc
JH
2538GetOptions() will not interpret a leading C<< "<>" >> as option starters
2539if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
2540option starters, use C<< "><" >>. Confusing? Well, B<using a starter
0b7031a2
GS
2541argument is strongly deprecated> anyway.
2542
2543=head2 Configuration variables
2544
2545Previous versions of Getopt::Long used variables for the purpose of
10e5c9cc
JH
2546configuring. Although manipulating these variables still work, it is
2547strongly encouraged to use the C<Configure> routine that was introduced
2548in version 2.17. Besides, it is much easier.
2549
8de02997
RGS
2550=head1 Tips and Techniques
2551
2552=head2 Pushing multiple values in a hash option
2553
2554Sometimes you want to combine the best of hashes and arrays. For
2555example, the command line:
2556
2557 --list add=first --list add=second --list add=third
2558
2559where each successive 'list add' option will push the value of add
2560into array ref $list->{'add'}. The result would be like
2561
2562 $list->{add} = [qw(first second third)];
2563
2564This can be accomplished with a destination routine:
2565
2566 GetOptions('list=s%' =>
2567 sub { push(@{$list{$_[1]}}, $_[2]) });
2568
10e5c9cc
JH
2569=head1 Trouble Shooting
2570
10e5c9cc
JH
2571=head2 GetOptions does not return a false result when an option is not supplied
2572
2573That's why they're called 'options'.
a0d0e21e 2574
2d08fc49
JH
2575=head2 GetOptions does not split the command line correctly
2576
2577The command line is not split by GetOptions, but by the command line
2578interpreter (CLI). On Unix, this is the shell. On Windows, it is
79d0183a 2579COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
2d08fc49
JH
2580
2581It is important to know that these CLIs may behave different when the
2582command line contains special characters, in particular quotes or
2583backslashes. For example, with Unix shells you can use single quotes
2584(C<'>) and double quotes (C<">) to group words together. The following
2585alternatives are equivalent on Unix:
2586
2587 "two words"
2588 'two words'
2589 two\ words
2590
2591In case of doubt, insert the following statement in front of your Perl
2592program:
2593
2594 print STDERR (join("|",@ARGV),"\n");
2595
2596to verify how your CLI passes the arguments to the program.
2597
10933be5
RGS
2598=head2 Undefined subroutine &main::GetOptions called
2599
2600Are you running Windows, and did you write
2601
2602 use GetOpt::Long;
2603
2604(note the capital 'O')?
2605
2d08fc49
JH
2606=head2 How do I put a "-?" option into a Getopt::Long?
2607
2608You can only obtain this using an alias, and Getopt::Long of at least
2609version 2.13.
2610
2611 use Getopt::Long;
2612 GetOptions ("help|?"); # -help and -? will both set $opt_help
2613
bb40d378 2614=head1 AUTHOR
a11f5414 2615
10e5c9cc 2616Johan Vromans <jvromans@squirrel.nl>
a11f5414 2617
bb40d378 2618=head1 COPYRIGHT AND DISCLAIMER
a11f5414 2619
8de02997 2620This program is Copyright 1990,2007 by Johan Vromans.
bb40d378 2621This program is free software; you can redistribute it and/or
1a505819
GS
2622modify it under the terms of the Perl Artistic License or the
2623GNU General Public License as published by the Free Software
2624Foundation; either version 2 of the License, or (at your option) any
2625later version.
a11f5414 2626
bb40d378
JV
2627This program is distributed in the hope that it will be useful,
2628but WITHOUT ANY WARRANTY; without even the implied warranty of
2629MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2630GNU General Public License for more details.
a0d0e21e 2631
bb40d378 2632If you do not have a copy of the GNU General Public License write to
10e5c9cc 2633the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
f9a400e4 2634MA 02139, USA.
a0d0e21e 2635
bb40d378 2636=cut
0b7031a2 2637