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