1 # GetOpt::Long.pm -- Universal options parsing
5 # RCS Status : $Id: GetoptLong.pm,v 2.9 1997-03-02 15:00:05+01 jv Exp $
6 # Author : Johan Vromans
7 # Created On : Tue Sep 11 15:00:12 1990
8 # Last Modified By: Johan Vromans
9 # Last Modified On: Sun Mar 2 14:59:41 1997
15 GetOptions - extended processing of command line options
20 $result = GetOptions (...option-descriptions...);
24 The Getopt::Long module implements an extended getopt function called
25 GetOptions(). This function adheres to the POSIX syntax for command
26 line options, with GNU extensions. In general, this means that options
27 have long names instead of single letters, and are introduced with a
28 double dash "--". Support for bundling of command line options, as was
29 the case with the more traditional single-letter approach, is provided
30 but not enabled by default. For example, the UNIX "ps" command can be
31 given the command line "option"
35 which means the combination of B<-v>, B<-a> and B<-x>. With the new
36 syntax B<--vax> would be a single option, probably indicating a
37 computer architecture.
39 Command line options can be used to set values. These values can be
40 specified in one of two ways:
45 GetOptions is called with a list of option-descriptions, each of which
46 consists of two elements: the option specifier and the option linkage.
47 The option specifier defines the name of the option and, optionally,
48 the value it can take. The option linkage is usually a reference to a
49 variable that will be set when the option is used. For example, the
50 following call to GetOptions:
52 &GetOptions("size=i" => \$offset);
54 will accept a command line option "size" that must have an integer
55 value. With a command line of "--size 24" this will cause the variable
56 $offset to get the value 24.
58 Alternatively, the first argument to GetOptions may be a reference to
59 a HASH describing the linkage for the options. The following call is
60 equivalent to the example above:
62 %optctl = ("size" => \$offset);
63 &GetOptions(\%optctl, "size=i");
65 Linkage may be specified using either of the above methods, or both.
66 Linkage specified in the argument list takes precedence over the
67 linkage specified in the HASH.
69 The command line options are taken from array @ARGV. Upon completion
70 of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
73 Each option specifier designates the name of the option, optionally
74 followed by an argument specifier. Values for argument specifiers are:
80 Option does not take an argument.
81 The option variable will be set to 1.
85 Option does not take an argument and may be negated, i.e. prefixed by
86 "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
88 The option variable will be set to 1, or 0 if negated.
92 Option takes a mandatory string argument.
93 This string will be assigned to the option variable.
94 Note that even if the string argument starts with B<-> or B<-->, it
95 will not be considered an option on itself.
99 Option takes an optional string argument.
100 This string will be assigned to the option variable.
101 If omitted, it will be assigned "" (an empty string).
102 If the string argument starts with B<-> or B<-->, it
103 will be considered an option on itself.
107 Option takes a mandatory integer argument.
108 This value will be assigned to the option variable.
109 Note that the value may start with B<-> to indicate a negative
114 Option takes an optional integer argument.
115 This value will be assigned to the option variable.
116 If omitted, the value 0 will be assigned.
117 Note that the value may start with B<-> to indicate a negative
122 Option takes a mandatory real number argument.
123 This value will be assigned to the option variable.
124 Note that the value may start with B<-> to indicate a negative
129 Option takes an optional real number argument.
130 This value will be assigned to the option variable.
131 If omitted, the value 0 will be assigned.
135 A lone dash B<-> is considered an option, the corresponding option
136 name is the empty string.
138 A double dash on itself B<--> signals end of the options list.
140 =head2 Linkage specification
142 The linkage specifier is optional. If no linkage is explicitly
143 specified but a ref HASH is passed, GetOptions will place the value in
144 the HASH. For example:
147 &GetOptions (\%optctl, "size=i");
149 will perform the equivalent of the assignment
151 $optctl{"size"} = 24;
153 For array options, a reference to an array is used, e.g.:
156 &GetOptions (\%optctl, "sizes=i@");
158 with command line "-sizes 24 -sizes 48" will perform the equivalent of
161 $optctl{"sizes"} = [24, 48];
163 For hash options (an option whose argument looks like "name=value"),
164 a reference to a hash is used, e.g.:
167 &GetOptions (\%optctl, "define=s%");
169 with command line "--define foo=hello --define bar=world" will perform the
170 equivalent of the assignment
172 $optctl{"define"} = {foo=>'hello', bar=>'world')
174 If no linkage is explicitly specified and no ref HASH is passed,
175 GetOptions will put the value in a global variable named after the
176 option, prefixed by "opt_". To yield a usable Perl variable,
177 characters that are not part of the syntax for variables are
178 translated to underscores. For example, "--fpp-struct-return" will set
179 the variable $opt_fpp_struct_return. Note that this variable resides
180 in the namespace of the calling program, not necessarily B<main>.
183 &GetOptions ("size=i", "sizes=i@");
185 with command line "-size 10 -sizes 24 -sizes 48" will perform the
186 equivalent of the assignments
189 @opt_sizes = (24, 48);
191 A lone dash B<-> is considered an option, the corresponding Perl
192 identifier is $opt_ .
194 The linkage specifier can be a reference to a scalar, a reference to
195 an array, a reference to a hash or a reference to a subroutine.
197 If a REF SCALAR is supplied, the new value is stored in the referenced
198 variable. If the option occurs more than once, the previous value is
201 If a REF ARRAY is supplied, the new value is appended (pushed) to the
204 If a REF HASH is supplied, the option value should look like "key" or
205 "key=value" (if the "=value" is omitted then a value of 1 is implied).
206 In this case, the element of the referenced hash with the key "key"
209 If a REF CODE is supplied, the referenced subroutine is called with
210 two arguments: the option name and the option value.
211 The option name is always the true name, not an abbreviation or alias.
213 =head2 Aliases and abbreviations
215 The option name may actually be a list of option names, separated by
216 "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
217 of this option. If no linkage is specified, options "foo", "bar" and
218 "blech" all will set $opt_foo.
220 Option names may be abbreviated to uniqueness, depending on
221 configuration option B<auto_abbrev>.
223 =head2 Non-option call-back routine
225 A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
226 to handle non-option arguments. GetOptions will immediately call this
227 subroutine for every non-option it encounters in the options list.
228 This subroutine gets the name of the non-option passed.
229 This feature requires configuration option B<permute>, see section
230 CONFIGURATION OPTIONS.
232 See also the examples.
234 =head2 Option starters
236 On the command line, options can start with B<-> (traditional), B<-->
237 (POSIX) and B<+> (GNU, now being phased out). The latter is not
238 allowed if the environment variable B<POSIXLY_CORRECT> has been
241 Options that start with "--" may have an argument appended, separated
242 with an "=", e.g. "--foo=bar".
246 A return status of 0 (false) indicates that the function detected
251 Getopt::Long::GetOptions() is the successor of
252 B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
253 In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
256 If an "@" sign is appended to the argument specifier, the option is
257 treated as an array. Value(s) are not set, but pushed into array
258 @opt_name. If explicit linkage is supplied, this must be a reference
261 If an "%" sign is appended to the argument specifier, the option is
262 treated as a hash. Value(s) of the form "name=value" are set by
263 setting the element of the hash %opt_name with key "name" to "value"
264 (if the "=value" portion is omitted it defaults to 1). If explicit
265 linkage is supplied, this must be a reference to a HASH.
267 If configuration option B<getopt_compat> is set (see section
268 CONFIGURATION OPTIONS), options that start with "+" or "-" may also
269 include their arguments, e.g. "+foo=bar". This is for compatiblity
270 with older implementations of the GNU "getopt" routine.
272 If the first argument to GetOptions is a string consisting of only
273 non-alphanumeric characters, it is taken to specify the option starter
274 characters. Everything starting with one of these characters from the
275 starter will be considered an option. B<Using a starter argument is
276 strongly deprecated.>
278 For convenience, option specifiers may have a leading B<-> or B<-->,
279 so it is possible to write:
281 GetOptions qw(-foo=s --bar=i --ar=s);
285 If the option specifier is "one:i" (i.e. takes an optional integer
286 argument), then the following situations are handled:
288 -one -two -> $opt_one = '', -two is next option
289 -one -2 -> $opt_one = -2
291 Also, assume specifiers "foo=s" and "bar:s" :
293 -bar -xxx -> $opt_bar = '', '-xxx' is next option
294 -foo -bar -> $opt_foo = '-bar'
295 -foo -- -> $opt_foo = '--'
297 In GNU or POSIX format, option names and values can be combined:
299 +foo=blech -> $opt_foo = 'blech'
300 --bar= -> $opt_bar = ''
301 --bar=-- -> $opt_bar = '--'
303 Example of using variable references:
305 $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
307 With command line options "-foo blech -bar 24 -ar xx -ar yy"
314 Example of using the E<lt>E<gt> option specifier:
316 @ARGV = qw(-foo 1 bar -foo 2 blech);
317 &GetOptions("foo=i", \$myfoo, "<>", \&mysub);
321 &mysub("bar") will be called (with $myfoo being 1)
322 &mysub("blech") will be called (with $myfoo being 2)
326 @ARGV = qw(-foo 1 bar -foo 2 blech);
327 &GetOptions("foo=i", \$myfoo);
329 This will leave the non-options in @ARGV:
332 @ARGV -> qw(bar blech)
334 =head1 CONFIGURATION OPTIONS
336 B<GetOptions> can be configured by calling subroutine
337 B<Getopt::Long::config>. This subroutine takes a list of quoted
338 strings, each specifying a configuration option to be set, e.g.
339 B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
340 B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
343 Previous versions of Getopt::Long used variables for the purpose of
344 configuring. Although manipulating these variables still work, it
345 is strongly encouraged to use the new B<config> routine. Besides, it
348 The following options are available:
354 This option causes all configuration options to be reset to their
359 Allow option names to be abbreviated to uniqueness.
360 Default is set unless environment variable
361 POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
365 Allow '+' to start options.
366 Default is set unless environment variable
367 POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
371 Whether non-options are allowed to be mixed with
373 Default is set unless environment variable
374 POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
376 See also B<permute>, which is the opposite of B<require_order>.
380 Whether non-options are allowed to be mixed with
382 Default is set unless environment variable
383 POSIXLY_CORRECT has been set, in which case B<permute> is reset.
384 Note that B<permute> is the opposite of B<require_order>.
386 If B<permute> is set, this means that
388 -foo arg1 -bar arg2 arg3
392 -foo -bar arg1 arg2 arg3
394 If a non-option call-back routine is specified, @ARGV will always be
395 empty upon succesful return of GetOptions since all options have been
396 processed, except when B<--> is used:
398 -foo arg1 -bar arg2 -- arg3
400 will call the call-back routine for arg1 and arg2, and terminate
401 leaving arg2 in @ARGV.
403 If B<require_order> is set, options processing
404 terminates when the first non-option is encountered.
406 -foo arg1 -bar arg2 arg3
410 -foo -- arg1 -bar arg2 arg3
412 =item bundling (default: reset)
414 Setting this variable to a non-zero value will allow single-character
415 options to be bundled. To distinguish bundles from long option names,
416 long options must be introduced with B<--> and single-character
417 options (and bundles) with B<->. For example,
421 would be equivalent to
425 provided "vax", "v", "a" and "x" have been defined to be valid
428 Bundled options can also include a value in the bundle; this value has
429 to be the last part of the bundle, e.g.
437 Note: resetting B<bundling> also resets B<bundling_override>.
439 =item bundling_override (default: reset)
441 If B<bundling_override> is set, bundling is enabled as with
442 B<bundling> but now long option names override option bundles. In the
443 above example, B<-vax> would be interpreted as the option "vax", not
444 the bundle "v", "a", "x".
446 Note: resetting B<bundling_override> also resets B<bundling>.
448 B<Note:> Using option bundling can easily lead to unexpected results,
449 especially when mixing long options and bundles. Caveat emptor.
451 =item ignore_case (default: set)
453 If set, case is ignored when matching options.
455 Note: resetting B<ignore_case> also resets B<ignore_case_always>.
457 =item ignore_case_always (default: reset)
459 When bundling is in effect, case is ignored on single-character
462 Note: resetting B<ignore_case_always> also resets B<ignore_case>.
464 =item pass_through (default: reset)
466 Unknown options are passed through in @ARGV instead of being flagged
467 as errors. This makes it possible to write wrapper scripts that
468 process only part of the user supplied options, and passes the
469 remaining options to some other program.
471 This can be very confusing, especially when B<permute> is also set.
473 =item debug (default: reset)
475 Enable copious debugging output.
479 =head1 OTHER USEFUL VARIABLES
483 =item $Getopt::Long::VERSION
485 The version number of this Getopt::Long implementation in the format
486 C<major>.C<minor>. This can be used to have Exporter check the
489 use Getopt::Long 3.00;
491 You can inspect $Getopt::Long::major_version and
492 $Getopt::Long::minor_version for the individual components.
494 =item $Getopt::Long::error
496 Internal error flag. May be incremented from a call-back routine to
497 cause options parsing to fail.
503 ################ Copyright ################
505 # This program is Copyright 1990,1997 by Johan Vromans.
506 # This program is free software; you can redistribute it and/or
507 # modify it under the terms of the GNU General Public License
508 # as published by the Free Software Foundation; either version 2
509 # of the License, or (at your option) any later version.
511 # This program is distributed in the hope that it will be useful,
512 # but WITHOUT ANY WARRANTY; without even the implied warranty of
513 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
514 # GNU General Public License for more details.
516 # If you do not have a copy of the GNU General Public License write to
517 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
520 ################ Module Preamble ################
527 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
528 $VERSION = sprintf("%d.%02d", q$Revision: 2.9 $ =~ /(\d+)\.(\d+)/);
531 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
536 use vars @EXPORT, @EXPORT_OK;
537 # User visible variables.
538 use vars qw(&config $error $debug $major_version $minor_version);
539 # Deprecated visible variables.
540 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
543 ################ Local Variables ################
545 my $gen_prefix; # generic prefix (option starters)
546 my $argend; # option list terminator
547 my %opctl; # table of arg.specs (long and abbrevs)
548 my %bopctl; # table of arg.specs (bundles)
549 my @opctl; # the possible long option names
550 my $pkg; # current context. Needed if no linkage.
551 my %aliases; # alias table
552 my $genprefix; # so we can call the same module more
553 my $opt; # current option
554 my $arg; # current option value, if any
555 my $array; # current option is array typed
556 my $hash; # current option is hash typed
557 my $key; # hash key for a hash option
558 # than once in differing environments
559 my $config_defaults; # set config defaults
560 my $find_option; # helper routine
562 ################ Subroutines ################
566 my @optionlist = @_; # local copy of the option descriptions
567 $argend = '--'; # option list terminator
568 %opctl = (); # table of arg.specs (long and abbrevs)
569 %bopctl = (); # table of arg.specs (bundles)
570 $pkg = (caller)[0]; # current context
571 # Needed if linkage is omitted.
572 %aliases= (); # alias table
573 my @ret = (); # accum for non-options
574 my %linkage; # linkage
575 my $userlinkage; # user supplied HASH
576 $genprefix = $gen_prefix; # so we can call the same module many times
579 print STDERR ('GetOptions $Revision: 2.9 $ ',
580 "[GetOpt::Long $Getopt::Long::VERSION] -- ",
581 "called from package \"$pkg\".\n",
583 " autoabbrev=$autoabbrev".
584 ",bundling=$bundling",
585 ",getopt_compat=$getopt_compat",
587 ",\n ignorecase=$ignorecase",
588 ",passthrough=$passthrough",
589 ",genprefix=\"$genprefix\"",
593 # Check for ref HASH as first argument.
594 $userlinkage = undef;
595 if ( ref($optionlist[0]) && ref($optionlist[0]) eq 'HASH' ) {
596 $userlinkage = shift (@optionlist);
599 # See if the first element of the optionlist contains option
600 # starter characters.
601 if ( $optionlist[0] =~ /^\W+$/ ) {
602 $genprefix = shift (@optionlist);
604 $genprefix =~ s/(\W)/\\$1/g;
605 $genprefix = "[" . $genprefix . "]";
608 # Verify correctness of optionlist.
611 while ( @optionlist > 0 ) {
612 my $opt = shift (@optionlist);
614 # Strip leading prefix so people can specify "--foo=i" if they like.
615 $opt = $' if $opt =~ /^($genprefix)+/;
617 if ( $opt eq '<>' ) {
618 if ( (defined $userlinkage)
619 && !(@optionlist > 0 && ref($optionlist[0]))
620 && (exists $userlinkage->{$opt})
621 && ref($userlinkage->{$opt}) ) {
622 unshift (@optionlist, $userlinkage->{$opt});
624 unless ( @optionlist > 0
625 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
626 warn ("Option spec <> requires a reference to a subroutine\n");
630 $linkage{'<>'} = shift (@optionlist);
634 if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
635 warn ("Error in option spec: \"", $opt, "\"\n");
639 my ($o, $c, $a) = ($1, $2);
640 $c = '' unless defined $c;
642 if ( ! defined $o ) {
643 # empty -> '-' option
644 $opctl{$o = ''} = $c;
648 my @o = split (/\|/, $o);
649 my $linko = $o = $o[0];
650 # Force an alias if the option name is not locase.
651 $a = $o unless $o eq lc($o);
655 && ($bundling ? length($o) > 1 : 1));
658 if ( $bundling && length($_) == 1 ) {
659 $_ = lc ($_) if $ignorecase > 1;
662 warn ("Ignoring '!' modifier for short option $_\n");
668 $_ = lc ($_) if $ignorecase;
687 # If no linkage is supplied in the @optionlist, copy it from
688 # the userlinkage if available.
689 if ( defined $userlinkage ) {
690 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
691 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
692 print STDERR ("=> found userlinkage for \"$o\": ",
693 "$userlinkage->{$o}\n")
695 unshift (@optionlist, $userlinkage->{$o});
698 # Do nothing. Being undefined will be handled later.
704 # Copy the linkage. If omitted, link to global variable.
705 if ( @optionlist > 0 && ref($optionlist[0]) ) {
706 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
708 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
709 $linkage{$o} = shift (@optionlist);
711 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
712 $linkage{$o} = shift (@optionlist);
713 $opctl{$o} .= '@' unless $opctl{$o} =~ /\@$/;
715 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
716 $linkage{$o} = shift (@optionlist);
717 $opctl{$o} .= '%' unless $opctl{$o} =~ /\%$/;
720 warn ("Invalid option linkage for \"", $opt, "\"\n");
725 # Link to global $opt_XXX variable.
726 # Make sure a valid perl identifier results.
730 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
732 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
734 elsif ( $c =~ /%/ ) {
735 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
737 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
740 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
742 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
747 # Bail out if errors found.
750 # Sort the possible long option names.
751 @opctl = sort(keys (%opctl)) if $autoabbrev;
753 # Show the options tables if debugging.
757 while ( ($k,$v) = each(%opctl) ) {
758 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
762 while ( ($k,$v) = each(%bopctl) ) {
763 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
768 # Process argument list
769 while ( @ARGV > 0 ) {
771 #### Get next argument ####
773 $opt = shift (@ARGV);
776 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
778 #### Determine what we have ####
780 # Double dash is option list terminator.
781 if ( $opt eq $argend ) {
782 # Finish. Push back accumulated arguments and return.
783 unshift (@ARGV, @ret)
784 if $order == $PERMUTE;
785 return ($error == 0);
790 # find_option operates on the GLOBAL $opt and $arg!
791 if ( &$find_option () ) {
793 # find_option undefines $opt in case of errors.
794 next unless defined $opt;
796 if ( defined $arg ) {
797 $opt = $aliases{$opt} if defined $aliases{$opt};
799 if ( defined $linkage{$opt} ) {
800 print STDERR ("=> ref(\$L{$opt}) -> ",
801 ref($linkage{$opt}), "\n") if $debug;
803 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
804 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
805 ${$linkage{$opt}} = $arg;
807 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
808 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
810 push (@{$linkage{$opt}}, $arg);
812 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
813 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
815 $linkage{$opt}->{$key} = $arg;
817 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
818 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
820 &{$linkage{$opt}}($opt, $arg);
823 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
825 die ("Getopt::Long -- internal error!\n");
828 # No entry in linkage means entry in userlinkage.
830 if ( defined $userlinkage->{$opt} ) {
831 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
833 push (@{$userlinkage->{$opt}}, $arg);
836 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
838 $userlinkage->{$opt} = [$arg];
842 if ( defined $userlinkage->{$opt} ) {
843 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
845 $userlinkage->{$opt}->{$key} = $arg;
848 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
850 $userlinkage->{$opt} = {$key => $arg};
854 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
855 $userlinkage->{$opt} = $arg;
860 # Not an option. Save it if we $PERMUTE and don't have a <>.
861 elsif ( $order == $PERMUTE ) {
862 # Try non-options call-back.
864 if ( (defined ($cb = $linkage{'<>'})) ) {
868 print STDERR ("=> saving \"$tryopt\" ",
869 "(not an option, may permute)\n") if $debug;
870 push (@ret, $tryopt);
875 # ...otherwise, terminate.
877 # Push this one back and exit.
878 unshift (@ARGV, $tryopt);
879 return ($error == 0);
885 if ( $order == $PERMUTE ) {
886 # Push back accumulated arguments
887 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
888 if $debug && @ret > 0;
889 unshift (@ARGV, @ret) if @ret > 0;
892 return ($error == 0);
898 foreach $opt ( @options ) {
901 if ( $try =~ /^no_?/ ) {
905 if ( $try eq 'default' or $try eq 'defaults' ) {
906 &$config_defaults () if $action;
908 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
909 $autoabbrev = $action;
911 elsif ( $try eq 'getopt_compat' ) {
912 $getopt_compat = $action;
914 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
915 $ignorecase = $action;
917 elsif ( $try eq 'ignore_case_always' ) {
918 $ignorecase = $action ? 2 : 0;
920 elsif ( $try eq 'bundling' ) {
923 elsif ( $try eq 'bundling_override' ) {
924 $bundling = $action ? 2 : 0;
926 elsif ( $try eq 'require_order' ) {
927 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
929 elsif ( $try eq 'permute' ) {
930 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
932 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
933 $passthrough = $action;
935 elsif ( $try eq 'debug' ) {
939 $Carp::CarpLevel = 1;
940 Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
945 # Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1.
946 sub require_version {
948 my ($self, $wanted) = @_;
949 my $pkg = ref $self || $self;
950 my $version = $ {"${pkg}::VERSION"} || "(undef)";
952 $wanted .= '.0' unless $wanted =~ /\./;
953 $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
954 $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
955 if ( $version < $wanted ) {
956 $version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
957 $wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
958 $Carp::CarpLevel = 1;
959 Carp::croak("$pkg $wanted required--this is only version $version")
964 ################ Private Subroutines ################
968 return 0 unless $opt =~ /^$genprefix/;
973 my $optarg = undef; # value supplied with --opt=value
974 my $rest = undef; # remainder from unbundling
976 # If it is a long option, it may include the value.
977 if (($starter eq "--" || $getopt_compat)
978 && $opt =~ /^([^=]+)=/ ) {
981 print STDERR ("=> option \"", $opt,
982 "\", optarg = \"$optarg\"\n") if $debug;
987 my $tryopt = $opt; # option to try
988 my $optbl = \%opctl; # table to look it up (long names)
991 if ( $bundling && $starter eq '-' ) {
992 # Unbundle single letter option.
993 $rest = 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 $optbl = \%bopctl; # look it up in the short names table
1001 # If bundling == 2, long options can override bundles.
1002 if ( $bundling == 2 and
1003 defined ($type = $opctl{$tryopt.$rest}) ) {
1004 print STDERR ("=> $starter$tryopt rebundled to ",
1005 "$starter$tryopt$rest\n") if $debug;
1011 # Try auto-abbreviation.
1012 elsif ( $autoabbrev ) {
1013 # Downcase if allowed.
1014 $tryopt = $opt = lc ($opt) if $ignorecase;
1015 # Turn option name into pattern.
1016 my $pat = quotemeta ($opt);
1017 # Look up in option names.
1018 my @hits = grep (/^$pat/, @opctl);
1019 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
1020 "out of ", scalar(@opctl), "\n") if $debug;
1022 # Check for ambiguous results.
1023 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
1024 # See if all matches are for the same option.
1027 $_ = $aliases{$_} if defined $aliases{$_};
1030 # Now see if it really is ambiguous.
1031 unless ( keys(%hit) == 1 ) {
1032 return 0 if $passthrough;
1033 print STDERR ("Option ", $opt, " is ambiguous (",
1034 join(", ", @hits), ")\n");
1042 # Complete the option name, if appropriate.
1043 if ( @hits == 1 && $hits[0] ne $opt ) {
1045 $tryopt = lc ($tryopt) if $ignorecase;
1046 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
1051 # Map to all lowercase if ignoring case.
1052 elsif ( $ignorecase ) {
1053 $tryopt = lc ($opt);
1056 # Check validity by fetching the info.
1057 $type = $optbl->{$tryopt} unless defined $type;
1058 unless ( defined $type ) {
1059 return 0 if $passthrough;
1060 warn ("Unknown option: ", $opt, "\n");
1066 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
1068 #### Determine argument status ####
1070 # If it is an option w/o argument, we're almost finished with it.
1071 if ( $type eq '' || $type eq '!' ) {
1072 if ( defined $optarg ) {
1073 return 0 if $passthrough;
1074 print STDERR ("Option ", $opt, " does not take an argument\n");
1078 elsif ( $type eq '' ) {
1079 $arg = 1; # supply explicit value
1082 substr ($opt, 0, 2) = ''; # strip NO prefix
1083 $arg = 0; # supply explicit value
1085 unshift (@ARGV, $starter.$rest) if defined $rest;
1089 # Get mandatory status and type info.
1091 ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
1093 # Check if there is an option argument available.
1094 if ( defined $optarg ? ($optarg eq '')
1095 : !(defined $rest || @ARGV > 0) ) {
1096 # Complain if this option needs an argument.
1097 if ( $mand eq "=" ) {
1098 return 0 if $passthrough;
1099 print STDERR ("Option ", $opt, " requires an argument\n");
1103 if ( $mand eq ":" ) {
1104 $arg = $type eq "s" ? '' : 0;
1109 # Get (possibly optional) argument.
1110 $arg = (defined $rest ? $rest
1111 : (defined $optarg ? $optarg : shift (@ARGV)));
1113 # Get key if this is a "name=value" pair for a hash option.
1115 if ($hash && defined $arg) {
1116 ($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
1119 #### Check if the argument is valid for this option ####
1121 if ( $type eq "s" ) { # string
1122 # A mandatory string takes anything.
1123 return 1 if $mand eq "=";
1125 # An optional string takes almost anything.
1126 return 1 if defined $optarg || defined $rest;
1127 return 1 if $arg eq "-"; # ??
1129 # Check for option or option list terminator.
1130 if ($arg eq $argend ||
1131 $arg =~ /^$genprefix.+/) {
1133 unshift (@ARGV, $arg);
1134 # Supply empty value.
1139 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
1140 if ( $arg !~ /^-?[0-9]+$/ ) {
1141 if ( defined $optarg || $mand eq "=" ) {
1142 return 0 if $passthrough;
1143 print STDERR ("Value \"", $arg, "\" invalid for option ",
1144 $opt, " (number expected)\n");
1148 unshift (@ARGV, $starter.$rest) if defined $rest;
1152 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1153 # Supply default value.
1159 elsif ( $type eq "f" ) { # real number, int is also ok
1160 if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
1161 if ( defined $optarg || $mand eq "=" ) {
1162 return 0 if $passthrough;
1163 print STDERR ("Value \"", $arg, "\" invalid for option ",
1164 $opt, " (real number expected)\n");
1168 unshift (@ARGV, $starter.$rest) if defined $rest;
1172 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1173 # Supply default value.
1179 die ("GetOpt::Long internal error (Can't happen)\n");
1184 $config_defaults = sub {
1185 # Handle POSIX compliancy.
1186 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
1187 $gen_prefix = "(--|-)";
1188 $autoabbrev = 0; # no automatic abbrev of options
1189 $bundling = 0; # no bundling of single letter switches
1190 $getopt_compat = 0; # disallow '+' to start options
1191 $order = $REQUIRE_ORDER;
1194 $gen_prefix = "(--|-|\\+)";
1195 $autoabbrev = 1; # automatic abbrev of options
1196 $bundling = 0; # bundling off by default
1197 $getopt_compat = 1; # allow '+' to start options
1200 # Other configurable settings.
1201 $debug = 0; # for debugging
1202 $error = 0; # error tally
1203 $ignorecase = 1; # ignore case when matching options
1204 $passthrough = 0; # leave unrecognized options alone
1207 ################ Initialization ################
1209 # Values for $order. See GNU getopt.c for details.
1210 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
1211 # Version major/minor numbers.
1212 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
1215 &$config_defaults ();
1217 ################ Package return ################