1 # GetOpt::Long.pm -- POSIX compatible options parsing
3 # RCS Status : $Id: GetoptLong.pm,v 2.6 1997-01-11 13:12:01+01 jv Exp $
4 # Author : Johan Vromans
5 # Created On : Tue Sep 11 15:00:12 1990
6 # Last Modified By: Johan Vromans
7 # Last Modified On: Sat Jan 11 13:11:35 1997
16 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
17 $VERSION = sprintf("%d.%02d", '$Revision: 2.6002 $ ' =~ /(\d+)\.(\d+)/);
18 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
19 $passthrough $error $debug
20 $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER
21 $VERSION $major_version $minor_version);
26 GetOptions - extended processing of command line options
31 $result = GetOptions (...option-descriptions...);
35 The Getopt::Long module implements an extended getopt function called
36 GetOptions(). This function adheres to the POSIX syntax for command
37 line options, with GNU extensions. In general, this means that options
38 have long names instead of single letters, and are introduced with a
39 double dash "--". Support for bundling of command line options, as was
40 the case with the more traditional single-letter approach, is provided
41 but not enabled by default. For example, the UNIX "ps" command can be
42 given the command line "option"
46 which means the combination of B<-v>, B<-a> and B<-x>. With the new
47 syntax B<--vax> would be a single option, probably indicating a
48 computer architecture.
50 Command line options can be used to set values. These values can be
51 specified in one of two ways:
56 GetOptions is called with a list of option-descriptions, each of which
57 consists of two elements: the option specifier and the option linkage.
58 The option specifier defines the name of the option and, optionally,
59 the value it can take. The option linkage is usually a reference to a
60 variable that will be set when the option is used. For example, the
61 following call to GetOptions:
63 &GetOptions("size=i" => \$offset);
65 will accept a command line option "size" that must have an integer
66 value. With a command line of "--size 24" this will cause the variable
67 $offset to get the value 24.
69 Alternatively, the first argument to GetOptions may be a reference to
70 a HASH describing the linkage for the options. The following call is
71 equivalent to the example above:
73 %optctl = ("size" => \$offset);
74 &GetOptions(\%optctl, "size=i");
76 Linkage may be specified using either of the above methods, or both.
77 Linkage specified in the argument list takes precedence over the
78 linkage specified in the HASH.
80 The command line options are taken from array @ARGV. Upon completion
81 of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
84 Each option specifier designates the name of the option, optionally
85 followed by an argument specifier. Values for argument specifiers are:
91 Option does not take an argument.
92 The option variable will be set to 1.
96 Option does not take an argument and may be negated, i.e. prefixed by
97 "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
99 The option variable will be set to 1, or 0 if negated.
103 Option takes a mandatory string argument.
104 This string will be assigned to the option variable.
105 Note that even if the string argument starts with B<-> or B<-->, it
106 will not be considered an option on itself.
110 Option takes an optional string argument.
111 This string will be assigned to the option variable.
112 If omitted, it will be assigned "" (an empty string).
113 If the string argument starts with B<-> or B<-->, it
114 will be considered an option on itself.
118 Option takes a mandatory integer argument.
119 This value will be assigned to the option variable.
120 Note that the value may start with B<-> to indicate a negative
125 Option takes an optional integer argument.
126 This value will be assigned to the option variable.
127 If omitted, the value 0 will be assigned.
128 Note that the value may start with B<-> to indicate a negative
133 Option takes a mandatory real number argument.
134 This value will be assigned to the option variable.
135 Note that the value may start with B<-> to indicate a negative
140 Option takes an optional real number argument.
141 This value will be assigned to the option variable.
142 If omitted, the value 0 will be assigned.
146 A lone dash B<-> is considered an option, the corresponding option
147 name is the empty string.
149 A double dash on itself B<--> signals end of the options list.
151 =head2 Linkage specification
153 The linkage specifier is optional. If no linkage is explicitly
154 specified but a ref HASH is passed, GetOptions will place the value in
155 the HASH. For example:
158 &GetOptions (\%optctl, "size=i");
160 will perform the equivalent of the assignment
162 $optctl{"size"} = 24;
164 For array options, a reference to an array is used, e.g.:
167 &GetOptions (\%optctl, "sizes=i@");
169 with command line "-sizes 24 -sizes 48" will perform the equivalent of
172 $optctl{"sizes"} = [24, 48];
174 For hash options (an option whose argument looks like "name=value"),
175 a reference to a hash is used, e.g.:
178 &GetOptions (\%optctl, "define=s%");
180 with command line "--define foo=hello --define bar=world" will perform the
181 equivalent of the assignment
183 $optctl{"define"} = {foo=>'hello', bar=>'world')
185 If no linkage is explicitly specified and no ref HASH is passed,
186 GetOptions will put the value in a global variable named after the
187 option, prefixed by "opt_". To yield a usable Perl variable,
188 characters that are not part of the syntax for variables are
189 translated to underscores. For example, "--fpp-struct-return" will set
190 the variable $opt_fpp_struct_return. Note that this variable resides
191 in the namespace of the calling program, not necessarily B<main>.
194 &GetOptions ("size=i", "sizes=i@");
196 with command line "-size 10 -sizes 24 -sizes 48" will perform the
197 equivalent of the assignments
200 @opt_sizes = (24, 48);
202 A lone dash B<-> is considered an option, the corresponding Perl
203 identifier is $opt_ .
205 The linkage specifier can be a reference to a scalar, a reference to
206 an array, a reference to a hash or a reference to a subroutine.
208 If a REF SCALAR is supplied, the new value is stored in the referenced
209 variable. If the option occurs more than once, the previous value is
212 If a REF ARRAY is supplied, the new value is appended (pushed) to the
215 If a REF HASH is supplied, the option value should look like "key" or
216 "key=value" (if the "=value" is omitted then a value of 1 is implied).
217 In this case, the element of the referenced hash with the key "key"
220 If a REF CODE is supplied, the referenced subroutine is called with
221 two arguments: the option name and the option value.
222 The option name is always the true name, not an abbreviation or alias.
224 =head2 Aliases and abbreviations
226 The option name may actually be a list of option names, separated by
227 "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
228 of this option. If no linkage is specified, options "foo", "bar" and
229 "blech" all will set $opt_foo.
231 Option names may be abbreviated to uniqueness, depending on
232 configuration variable $Getopt::Long::autoabbrev.
234 =head2 Non-option call-back routine
236 A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
237 to handle non-option arguments. GetOptions will immediately call this
238 subroutine for every non-option it encounters in the options list.
239 This subroutine gets the name of the non-option passed.
240 This feature requires $Getopt::Long::order to have the value $PERMUTE.
241 See also the examples.
243 =head2 Option starters
245 On the command line, options can start with B<-> (traditional), B<-->
246 (POSIX) and B<+> (GNU, now being phased out). The latter is not
247 allowed if the environment variable B<POSIXLY_CORRECT> has been
250 Options that start with "--" may have an argument appended, separated
251 with an "=", e.g. "--foo=bar".
255 A return status of 0 (false) indicates that the function detected
260 Getopt::Long::GetOptions() is the successor of
261 B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
262 In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
265 If an "@" sign is appended to the argument specifier, the option is
266 treated as an array. Value(s) are not set, but pushed into array
267 @opt_name. If explicit linkage is supplied, this must be a reference
270 If an "%" sign is appended to the argument specifier, the option is
271 treated as a hash. Value(s) of the form "name=value" are set by
272 setting the element of the hash %opt_name with key "name" to "value"
273 (if the "=value" portion is omitted it defaults to 1). If explicit
274 linkage is supplied, this must be a reference to a HASH.
276 If configuration variable $Getopt::Long::getopt_compat is set to a
277 non-zero value, options that start with "+" or "-" may also include their
278 arguments, e.g. "+foo=bar". This is for compatiblity with older
279 implementations of the GNU "getopt" routine.
281 If the first argument to GetOptions is a string consisting of only
282 non-alphanumeric characters, it is taken to specify the option starter
283 characters. Everything starting with one of these characters from the
284 starter will be considered an option. B<Using a starter argument is
285 strongly deprecated.>
287 For convenience, option specifiers may have a leading B<-> or B<-->,
288 so it is possible to write:
290 GetOptions qw(-foo=s --bar=i --ar=s);
294 If the option specifier is "one:i" (i.e. takes an optional integer
295 argument), then the following situations are handled:
297 -one -two -> $opt_one = '', -two is next option
298 -one -2 -> $opt_one = -2
300 Also, assume specifiers "foo=s" and "bar:s" :
302 -bar -xxx -> $opt_bar = '', '-xxx' is next option
303 -foo -bar -> $opt_foo = '-bar'
304 -foo -- -> $opt_foo = '--'
306 In GNU or POSIX format, option names and values can be combined:
308 +foo=blech -> $opt_foo = 'blech'
309 --bar= -> $opt_bar = ''
310 --bar=-- -> $opt_bar = '--'
312 Example of using variable references:
314 $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
316 With command line options "-foo blech -bar 24 -ar xx -ar yy"
323 Example of using the E<lt>E<gt> option specifier:
325 @ARGV = qw(-foo 1 bar -foo 2 blech);
326 &GetOptions("foo=i", \$myfoo, "<>", \&mysub);
330 &mysub("bar") will be called (with $myfoo being 1)
331 &mysub("blech") will be called (with $myfoo being 2)
335 @ARGV = qw(-foo 1 bar -foo 2 blech);
336 &GetOptions("foo=i", \$myfoo);
338 This will leave the non-options in @ARGV:
341 @ARGV -> qw(bar blech)
343 =head1 CONFIGURATION VARIABLES
345 The following variables can be set to change the default behaviour of
350 =item $Getopt::Long::autoabbrev
352 Allow option names to be abbreviated to uniqueness.
353 Default is 1 unless environment variable
354 POSIXLY_CORRECT has been set.
356 =item $Getopt::Long::getopt_compat
358 Allow '+' to start options.
359 Default is 1 unless environment variable
360 POSIXLY_CORRECT has been set.
362 =item $Getopt::Long::order
364 Whether non-options are allowed to be mixed with
366 Default is $REQUIRE_ORDER if environment variable
367 POSIXLY_CORRECT has been set, $PERMUTE otherwise.
371 -foo arg1 -bar arg2 arg3
375 -foo -bar arg1 arg2 arg3
377 If a non-option call-back routine is specified, @ARGV will always be
378 empty upon succesful return of GetOptions since all options have been
379 processed, except when B<--> is used:
381 -foo arg1 -bar arg2 -- arg3
383 will call the call-back routine for arg1 and arg2, and terminate
384 leaving arg2 in @ARGV.
386 If $Getopt::Long::order is $REQUIRE_ORDER, options processing
387 terminates when the first non-option is encountered.
389 -foo arg1 -bar arg2 arg3
393 -foo -- arg1 -bar arg2 arg3
395 $RETURN_IN_ORDER is not supported by GetOptions().
397 =item $Getopt::Long::bundling
399 Setting this variable to a non-zero value will allow single-character
400 options to be bundled. To distinguish bundles from long option names,
401 long options must be introduced with B<--> and single-character
402 options (and bundles) with B<->. For example,
406 would be equivalent to
410 provided "vax", "v", "a" and "x" have been defined to be valid
413 Bundled options can also include a value in the bundle; this value has
414 to be the last part of the bundle, e.g.
422 B<Note:> Using option bundling can easily lead to unexpected results,
423 especially when mixing long options and bundles. Caveat emptor.
425 =item $Getopt::Long::ignorecase
427 Ignore case when matching options. Default is 1. When bundling is in
428 effect, case is ignored on single-character options only if
429 $Getopt::Long::ignorecase is greater than 1.
431 =item $Getopt::Long::passthrough
433 Unknown options are passed through in @ARGV instead of being flagged
434 as errors. This makes it possible to write wrapper scripts that
435 process only part of the user supplied options, and passes the
436 remaining options to some other program.
438 This can be very confusing, especially when $Getopt::Long::order is
441 =item $Getopt::Long::VERSION
443 The version number of this Getopt::Long implementation in the format
444 C<major>.C<minor>. This can be used to have Exporter check the
447 use Getopt::Long 2.00;
449 You can inspect $Getopt::Long::major_version and
450 $Getopt::Long::minor_version for the individual components.
452 =item $Getopt::Long::error
454 Internal error flag. May be incremented from a call-back routine to
455 cause options parsing to fail.
457 =item $Getopt::Long::debug
459 Enable copious debugging output. Default is 0.
465 ################ Introduction ################
467 # This program is Copyright 1990,1996 by Johan Vromans.
468 # This program is free software; you can redistribute it and/or
469 # modify it under the terms of the GNU General Public License
470 # as published by the Free Software Foundation; either version 2
471 # of the License, or (at your option) any later version.
473 # This program is distributed in the hope that it will be useful,
474 # but WITHOUT ANY WARRANTY; without even the implied warranty of
475 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
476 # GNU General Public License for more details.
478 # If you do not have a copy of the GNU General Public License write to
479 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
482 ################ Configuration Section ################
484 # Values for $order. See GNU getopt.c for details.
485 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
487 my $gen_prefix; # generic prefix (option starters)
489 # Handle POSIX compliancy.
490 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
491 $gen_prefix = "(--|-)";
492 $autoabbrev = 0; # no automatic abbrev of options
493 $bundling = 0; # no bundling of single letter switches
494 $getopt_compat = 0; # disallow '+' to start options
495 $order = $REQUIRE_ORDER;
498 $gen_prefix = "(--|-|\\+)";
499 $autoabbrev = 1; # automatic abbrev of options
500 $bundling = 0; # bundling off by default
501 $getopt_compat = 1; # allow '+' to start options
505 # Other configurable settings.
506 $debug = 0; # for debugging
507 $error = 0; # error tally
508 $ignorecase = 1; # ignore case when matching options
509 $passthrough = 0; # leave unrecognized options alone
510 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
512 use vars qw($genprefix %opctl @opctl %bopctl $opt $arg $argend $array);
513 use vars qw(%aliases $hash $key);
515 ################ Subroutines ################
519 my @optionlist = @_; # local copy of the option descriptions
520 local ($argend) = '--'; # option list terminator
521 local (%opctl); # table of arg.specs (long and abbrevs)
522 local (%bopctl); # table of arg.specs (bundles)
523 my $pkg = (caller)[0]; # current context
524 # Needed if linkage is omitted.
525 local (%aliases); # alias table
526 my @ret = (); # accum for non-options
527 my %linkage; # linkage
528 my $userlinkage; # user supplied HASH
529 local ($genprefix) = $gen_prefix; # so we can call the same module more
530 # than once in differing environments
533 print STDERR ('GetOptions $Revision: 2.6001 $ ',
534 "[GetOpt::Long $Getopt::Long::VERSION] -- ",
535 "called from package \"$pkg\".\n",
537 " autoabbrev=$autoabbrev".
538 ",bundling=$bundling",
539 ",getopt_compat=$getopt_compat",
541 ",\n ignorecase=$ignorecase",
542 ",passthrough=$passthrough",
543 ",genprefix=\"$genprefix\"",
547 # Check for ref HASH as first argument.
548 $userlinkage = undef;
549 if ( ref($optionlist[0]) && ref($optionlist[0]) eq 'HASH' ) {
550 $userlinkage = shift (@optionlist);
553 # See if the first element of the optionlist contains option
554 # starter characters.
555 if ( $optionlist[0] =~ /^\W+$/ ) {
556 $genprefix = shift (@optionlist);
558 $genprefix =~ s/(\W)/\\$1/g;
559 $genprefix = "[" . $genprefix . "]";
562 # Verify correctness of optionlist.
565 while ( @optionlist > 0 ) {
566 my $opt = shift (@optionlist);
568 # Strip leading prefix so people can specify "--foo=i" if they like.
569 $opt =~ s/^(?:$genprefix)+//s;
571 if ( $opt eq '<>' ) {
572 if ( (defined $userlinkage)
573 && !(@optionlist > 0 && ref($optionlist[0]))
574 && (exists $userlinkage->{$opt})
575 && ref($userlinkage->{$opt}) ) {
576 unshift (@optionlist, $userlinkage->{$opt});
578 unless ( @optionlist > 0
579 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
580 warn ("Option spec <> requires a reference to a subroutine\n");
584 $linkage{'<>'} = shift (@optionlist);
588 if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
589 warn ("Error in option spec: \"", $opt, "\"\n");
593 my ($o, $c, $a) = ($1, $2);
594 $c = '' unless defined $c;
596 if ( ! defined $o ) {
597 # empty -> '-' option
598 $opctl{$o = ''} = $c;
602 my @o = split (/\|/, $o);
603 my $linko = $o = $o[0];
604 # Force an alias if the option name is not locase.
605 $a = $o unless $o eq lc($o);
609 && ($bundling ? length($o) > 1 : 1));
612 if ( $bundling && length($_) == 1 ) {
613 $_ = lc ($_) if $ignorecase > 1;
616 warn ("Ignoring '!' modifier for short option $_\n");
622 $_ = lc ($_) if $ignorecase;
641 # If no linkage is supplied in the @optionlist, copy it from
642 # the userlinkage if available.
643 if ( defined $userlinkage ) {
644 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
645 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
646 print STDERR ("=> found userlinkage for \"$o\": ",
647 "$userlinkage->{$o}\n")
649 unshift (@optionlist, $userlinkage->{$o});
652 # Do nothing. Being undefined will be handled later.
658 # Copy the linkage. If omitted, link to global variable.
659 if ( @optionlist > 0 && ref($optionlist[0]) ) {
660 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
662 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
663 $linkage{$o} = shift (@optionlist);
665 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
666 $linkage{$o} = shift (@optionlist);
667 $opctl{$o} .= '@' unless $opctl{$o} =~ /\@$/;
669 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
670 $linkage{$o} = shift (@optionlist);
671 $opctl{$o} .= '%' unless $opctl{$o} =~ /\%$/;
674 warn ("Invalid option linkage for \"", $opt, "\"\n");
679 # Link to global $opt_XXX variable.
680 # Make sure a valid perl identifier results.
684 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
686 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
688 elsif ( $c =~ /%/ ) {
689 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
691 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
694 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
696 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
701 # Bail out if errors found.
704 # Sort the possible long option names.
705 local (@opctl) = sort(keys (%opctl)) if $autoabbrev;
707 # Show the options tables if debugging.
711 while ( ($k,$v) = each(%opctl) ) {
712 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
716 while ( ($k,$v) = each(%bopctl) ) {
717 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
722 local ($opt); # current option
723 local ($arg); # current option value, if any
724 local ($array); # current option is array typed
725 local ($hash); # current option is hash typed
726 local ($key); # hash key for a hash option
728 # Process argument list
729 while ( @ARGV > 0 ) {
731 #### Get next argument ####
733 $opt = shift (@ARGV);
736 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
738 #### Determine what we have ####
740 # Double dash is option list terminator.
741 if ( $opt eq $argend ) {
742 # Finish. Push back accumulated arguments and return.
743 unshift (@ARGV, @ret)
744 if $order == $PERMUTE;
745 return ($error == 0);
750 # find_option operates on the GLOBAL $opt and $arg!
751 if ( &find_option ) {
753 # find_option undefines $opt in case of errors.
754 next unless defined $opt;
756 if ( defined $arg ) {
757 $opt = $aliases{$opt} if defined $aliases{$opt};
759 if ( defined $linkage{$opt} ) {
760 print STDERR ("=> ref(\$L{$opt}) -> ",
761 ref($linkage{$opt}), "\n") if $debug;
763 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
764 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
765 ${$linkage{$opt}} = $arg;
767 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
768 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
770 push (@{$linkage{$opt}}, $arg);
772 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
773 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
775 $linkage{$opt}->{$key} = $arg;
777 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
778 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
780 &{$linkage{$opt}}($opt, $arg);
783 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
785 die ("Getopt::Long -- internal error!\n");
788 # No entry in linkage means entry in userlinkage.
790 if ( defined $userlinkage->{$opt} ) {
791 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
793 push (@{$userlinkage->{$opt}}, $arg);
796 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
798 $userlinkage->{$opt} = [$arg];
802 if ( defined $userlinkage->{$opt} ) {
803 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
805 $userlinkage->{$opt}->{$key} = $arg;
808 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
810 $userlinkage->{$opt} = {$key => $arg};
814 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
815 $userlinkage->{$opt} = $arg;
820 # Not an option. Save it if we $PERMUTE and don't have a <>.
821 elsif ( $order == $PERMUTE ) {
822 # Try non-options call-back.
824 if ( (defined ($cb = $linkage{'<>'})) ) {
828 print STDERR ("=> saving \"$tryopt\" ",
829 "(not an option, may permute)\n") if $debug;
830 push (@ret, $tryopt);
835 # ...otherwise, terminate.
837 # Push this one back and exit.
838 unshift (@ARGV, $tryopt);
839 return ($error == 0);
845 if ( $order == $PERMUTE ) {
846 # Push back accumulated arguments
847 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
848 if $debug && @ret > 0;
849 unshift (@ARGV, @ret) if @ret > 0;
852 return ($error == 0);
857 return 0 unless $opt =~ /^($genprefix)(.*)/s;
862 my $optarg = undef; # value supplied with --opt=value
863 my $rest = undef; # remainder from unbundling
865 # If it is a long option, it may include the value.
866 if (($starter eq "--" || $getopt_compat)
867 && $opt =~ /^([^=]+)=(.*)/s ) {
870 print STDERR ("=> option \"", $opt,
871 "\", optarg = \"$optarg\"\n") if $debug;
876 my $tryopt = $opt; # option to try
877 my $optbl = \%opctl; # table to look it up (long names)
879 if ( $bundling && $starter eq '-' ) {
880 # Unbundle single letter option.
881 $rest = substr ($tryopt, 1);
882 $tryopt = substr ($tryopt, 0, 1);
883 $tryopt = lc ($tryopt) if $ignorecase > 1;
884 print STDERR ("=> $starter$tryopt unbundled from ",
885 "$starter$tryopt$rest\n") if $debug;
886 $rest = undef unless $rest ne '';
887 $optbl = \%bopctl; # look it up in the short names table
890 # Try auto-abbreviation.
891 elsif ( $autoabbrev ) {
892 # Downcase if allowed.
893 $tryopt = $opt = lc ($opt) if $ignorecase;
894 # Turn option name into pattern.
895 my $pat = quotemeta ($opt);
896 # Look up in option names.
897 my @hits = grep (/^$pat/, @opctl);
898 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
899 "out of ", scalar(@opctl), "\n") if $debug;
901 # Check for ambiguous results.
902 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
903 # See if all matches are for the same option.
906 $_ = $aliases{$_} if defined $aliases{$_};
909 # Now see if it really is ambiguous.
910 unless ( keys(%hit) == 1 ) {
911 return 0 if $passthrough;
912 print STDERR ("Option ", $opt, " is ambiguous (",
913 join(", ", @hits), ")\n");
921 # Complete the option name, if appropriate.
922 if ( @hits == 1 && $hits[0] ne $opt ) {
924 $tryopt = lc ($tryopt) if $ignorecase;
925 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
930 # Map to all lowercase if ignoring case.
931 elsif ( $ignorecase ) {
935 # Check validity by fetching the info.
936 my $type = $optbl->{$tryopt};
937 unless ( defined $type ) {
938 return 0 if $passthrough;
939 warn ("Unknown option: ", $opt, "\n");
945 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
947 #### Determine argument status ####
949 # If it is an option w/o argument, we're almost finished with it.
950 if ( $type eq '' || $type eq '!' ) {
951 if ( defined $optarg ) {
952 return 0 if $passthrough;
953 print STDERR ("Option ", $opt, " does not take an argument\n");
957 elsif ( $type eq '' ) {
958 $arg = 1; # supply explicit value
961 substr ($opt, 0, 2) = ''; # strip NO prefix
962 $arg = 0; # supply explicit value
964 unshift (@ARGV, $starter.$rest) if defined $rest;
968 # Get mandatory status and type info.
970 ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
972 # Check if there is an option argument available.
973 if ( defined $optarg ? ($optarg eq '')
974 : !(defined $rest || @ARGV > 0) ) {
975 # Complain if this option needs an argument.
976 if ( $mand eq "=" ) {
977 return 0 if $passthrough;
978 print STDERR ("Option ", $opt, " requires an argument\n");
982 if ( $mand eq ":" ) {
983 $arg = $type eq "s" ? '' : 0;
988 # Get (possibly optional) argument.
989 $arg = (defined $rest ? $rest
990 : (defined $optarg ? $optarg : shift (@ARGV)));
992 # Get key if this is a "name=value" pair for a hash option.
994 if ($hash && defined $arg) {
995 ($key, $arg) = ($arg =~ /(.*?)=(.*)/s) ? ($1, $2) : ($arg, 1);
998 #### Check if the argument is valid for this option ####
1000 if ( $type eq "s" ) { # string
1001 # A mandatory string takes anything.
1002 return 1 if $mand eq "=";
1004 # An optional string takes almost anything.
1005 return 1 if defined $optarg || defined $rest;
1006 return 1 if $arg eq "-"; # ??
1008 # Check for option or option list terminator.
1009 if ($arg eq $argend ||
1010 $arg =~ /^$genprefix.+/) {
1012 unshift (@ARGV, $arg);
1013 # Supply empty value.
1018 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
1019 if ( $arg !~ /^-?[0-9]+$/ ) {
1020 if ( defined $optarg || $mand eq "=" ) {
1021 return 0 if $passthrough;
1022 print STDERR ("Value \"", $arg, "\" invalid for option ",
1023 $opt, " (number expected)\n");
1027 unshift (@ARGV, $starter.$rest) if defined $rest;
1031 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1032 # Supply default value.
1038 elsif ( $type eq "f" ) { # real number, int is also ok
1039 if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
1040 if ( defined $optarg || $mand eq "=" ) {
1041 return 0 if $passthrough;
1042 print STDERR ("Value \"", $arg, "\" invalid for option ",
1043 $opt, " (real number expected)\n");
1047 unshift (@ARGV, $starter.$rest) if defined $rest;
1051 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1052 # Supply default value.
1058 die ("GetOpt::Long internal error (Can't happen)\n");
1063 ################ Package return ################