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