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