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