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