← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:03 2021

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