1 # GetOpt::Long.pm -- Universal options parsing
5 # RCS Status : $Id: GetoptLong.pm,v 2.10 1997-04-18 22:21:10+02 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: Wed Apr 16 16:27:33 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.10 $ =~ /(\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($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.10 $ ',
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");
665 $opctl{$_} = $bopctl{$_} = $c;
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);
714 if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
716 if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
718 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
719 $linkage{$o} = shift (@optionlist);
721 if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
723 if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
726 warn ("Invalid option linkage for \"", $opt, "\"\n");
731 # Link to global $opt_XXX variable.
732 # Make sure a valid perl identifier results.
736 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
738 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
740 elsif ( $c =~ /%/ ) {
741 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
743 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
746 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
748 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
753 # Bail out if errors found.
756 # Sort the possible long option names.
757 @opctl = sort(keys (%opctl)) if $autoabbrev;
759 # Show the options tables if debugging.
763 while ( ($k,$v) = each(%opctl) ) {
764 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
768 while ( ($k,$v) = each(%bopctl) ) {
769 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
774 # Process argument list
775 while ( @ARGV > 0 ) {
777 #### Get next argument ####
779 $opt = shift (@ARGV);
782 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
784 #### Determine what we have ####
786 # Double dash is option list terminator.
787 if ( $opt eq $argend ) {
788 # Finish. Push back accumulated arguments and return.
789 unshift (@ARGV, @ret)
790 if $order == $PERMUTE;
791 return ($error == 0);
796 # find_option operates on the GLOBAL $opt and $arg!
797 if ( &$find_option () ) {
799 # find_option undefines $opt in case of errors.
800 next unless defined $opt;
802 if ( defined $arg ) {
803 $opt = $aliases{$opt} if defined $aliases{$opt};
805 if ( defined $linkage{$opt} ) {
806 print STDERR ("=> ref(\$L{$opt}) -> ",
807 ref($linkage{$opt}), "\n") if $debug;
809 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
810 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
811 ${$linkage{$opt}} = $arg;
813 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
814 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
816 push (@{$linkage{$opt}}, $arg);
818 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
819 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
821 $linkage{$opt}->{$key} = $arg;
823 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
824 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
826 &{$linkage{$opt}}($opt, $arg);
829 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
831 die ("Getopt::Long -- internal error!\n");
834 # No entry in linkage means entry in userlinkage.
836 if ( defined $userlinkage->{$opt} ) {
837 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
839 push (@{$userlinkage->{$opt}}, $arg);
842 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
844 $userlinkage->{$opt} = [$arg];
848 if ( defined $userlinkage->{$opt} ) {
849 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
851 $userlinkage->{$opt}->{$key} = $arg;
854 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
856 $userlinkage->{$opt} = {$key => $arg};
860 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
861 $userlinkage->{$opt} = $arg;
866 # Not an option. Save it if we $PERMUTE and don't have a <>.
867 elsif ( $order == $PERMUTE ) {
868 # Try non-options call-back.
870 if ( (defined ($cb = $linkage{'<>'})) ) {
874 print STDERR ("=> saving \"$tryopt\" ",
875 "(not an option, may permute)\n") if $debug;
876 push (@ret, $tryopt);
881 # ...otherwise, terminate.
883 # Push this one back and exit.
884 unshift (@ARGV, $tryopt);
885 return ($error == 0);
891 if ( $order == $PERMUTE ) {
892 # Push back accumulated arguments
893 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
894 if $debug && @ret > 0;
895 unshift (@ARGV, @ret) if @ret > 0;
898 return ($error == 0);
904 foreach $opt ( @options ) {
907 if ( $try =~ /^no_?/ ) {
911 if ( $try eq 'default' or $try eq 'defaults' ) {
912 &$config_defaults () if $action;
914 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
915 $autoabbrev = $action;
917 elsif ( $try eq 'getopt_compat' ) {
918 $getopt_compat = $action;
920 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
921 $ignorecase = $action;
923 elsif ( $try eq 'ignore_case_always' ) {
924 $ignorecase = $action ? 2 : 0;
926 elsif ( $try eq 'bundling' ) {
929 elsif ( $try eq 'bundling_override' ) {
930 $bundling = $action ? 2 : 0;
932 elsif ( $try eq 'require_order' ) {
933 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
935 elsif ( $try eq 'permute' ) {
936 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
938 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
939 $passthrough = $action;
941 elsif ( $try eq 'debug' ) {
945 $Carp::CarpLevel = 1;
946 Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
951 # Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1.
952 sub require_version {
954 my ($self, $wanted) = @_;
955 my $pkg = ref $self || $self;
956 my $version = $ {"${pkg}::VERSION"} || "(undef)";
958 $wanted .= '.0' unless $wanted =~ /\./;
959 $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
960 $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
961 if ( $version < $wanted ) {
962 $version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
963 $wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
964 $Carp::CarpLevel = 1;
965 Carp::croak("$pkg $wanted required--this is only version $version")
970 ################ Private Subroutines ################
974 return 0 unless $opt =~ /^$genprefix/;
979 my $optarg = undef; # value supplied with --opt=value
980 my $rest = undef; # remainder from unbundling
982 # If it is a long option, it may include the value.
983 if (($starter eq "--" || $getopt_compat)
984 && $opt =~ /^([^=]+)=/ ) {
987 print STDERR ("=> option \"", $opt,
988 "\", optarg = \"$optarg\"\n") if $debug;
993 my $tryopt = $opt; # option to try
994 my $optbl = \%opctl; # table to look it up (long names)
997 if ( $bundling && $starter eq '-' ) {
998 # Unbundle single letter option.
999 $rest = substr ($tryopt, 1);
1000 $tryopt = substr ($tryopt, 0, 1);
1001 $tryopt = lc ($tryopt) if $ignorecase > 1;
1002 print STDERR ("=> $starter$tryopt unbundled from ",
1003 "$starter$tryopt$rest\n") if $debug;
1004 $rest = undef unless $rest ne '';
1005 $optbl = \%bopctl; # look it up in the short names table
1007 # If bundling == 2, long options can override bundles.
1008 if ( $bundling == 2 and
1009 defined ($type = $opctl{$tryopt.$rest}) ) {
1010 print STDERR ("=> $starter$tryopt rebundled to ",
1011 "$starter$tryopt$rest\n") if $debug;
1017 # Try auto-abbreviation.
1018 elsif ( $autoabbrev ) {
1019 # Downcase if allowed.
1020 $tryopt = $opt = lc ($opt) if $ignorecase;
1021 # Turn option name into pattern.
1022 my $pat = quotemeta ($opt);
1023 # Look up in option names.
1024 my @hits = grep (/^$pat/, @opctl);
1025 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
1026 "out of ", scalar(@opctl), "\n") if $debug;
1028 # Check for ambiguous results.
1029 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
1030 # See if all matches are for the same option.
1033 $_ = $aliases{$_} if defined $aliases{$_};
1036 # Now see if it really is ambiguous.
1037 unless ( keys(%hit) == 1 ) {
1038 return 0 if $passthrough;
1039 print STDERR ("Option ", $opt, " is ambiguous (",
1040 join(", ", @hits), ")\n");
1048 # Complete the option name, if appropriate.
1049 if ( @hits == 1 && $hits[0] ne $opt ) {
1051 $tryopt = lc ($tryopt) if $ignorecase;
1052 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
1057 # Map to all lowercase if ignoring case.
1058 elsif ( $ignorecase ) {
1059 $tryopt = lc ($opt);
1062 # Check validity by fetching the info.
1063 $type = $optbl->{$tryopt} unless defined $type;
1064 unless ( defined $type ) {
1065 return 0 if $passthrough;
1066 warn ("Unknown option: ", $opt, "\n");
1072 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
1074 #### Determine argument status ####
1076 # If it is an option w/o argument, we're almost finished with it.
1077 if ( $type eq '' || $type eq '!' ) {
1078 if ( defined $optarg ) {
1079 return 0 if $passthrough;
1080 print STDERR ("Option ", $opt, " does not take an argument\n");
1084 elsif ( $type eq '' ) {
1085 $arg = 1; # supply explicit value
1088 substr ($opt, 0, 2) = ''; # strip NO prefix
1089 $arg = 0; # supply explicit value
1091 unshift (@ARGV, $starter.$rest) if defined $rest;
1095 # Get mandatory status and type info.
1097 ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
1099 # Check if there is an option argument available.
1100 if ( defined $optarg ? ($optarg eq '')
1101 : !(defined $rest || @ARGV > 0) ) {
1102 # Complain if this option needs an argument.
1103 if ( $mand eq "=" ) {
1104 return 0 if $passthrough;
1105 print STDERR ("Option ", $opt, " requires an argument\n");
1109 if ( $mand eq ":" ) {
1110 $arg = $type eq "s" ? '' : 0;
1115 # Get (possibly optional) argument.
1116 $arg = (defined $rest ? $rest
1117 : (defined $optarg ? $optarg : shift (@ARGV)));
1119 # Get key if this is a "name=value" pair for a hash option.
1121 if ($hash && defined $arg) {
1122 ($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
1125 #### Check if the argument is valid for this option ####
1127 if ( $type eq "s" ) { # string
1128 # A mandatory string takes anything.
1129 return 1 if $mand eq "=";
1131 # An optional string takes almost anything.
1132 return 1 if defined $optarg || defined $rest;
1133 return 1 if $arg eq "-"; # ??
1135 # Check for option or option list terminator.
1136 if ($arg eq $argend ||
1137 $arg =~ /^$genprefix.+/) {
1139 unshift (@ARGV, $arg);
1140 # Supply empty value.
1145 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
1146 if ( $arg !~ /^-?[0-9]+$/ ) {
1147 if ( defined $optarg || $mand eq "=" ) {
1148 return 0 if $passthrough;
1149 print STDERR ("Value \"", $arg, "\" invalid for option ",
1150 $opt, " (number expected)\n");
1154 unshift (@ARGV, $starter.$rest) if defined $rest;
1158 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1159 # Supply default value.
1165 elsif ( $type eq "f" ) { # real number, int is also ok
1166 if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
1167 if ( defined $optarg || $mand eq "=" ) {
1168 return 0 if $passthrough;
1169 print STDERR ("Value \"", $arg, "\" invalid for option ",
1170 $opt, " (real number expected)\n");
1174 unshift (@ARGV, $starter.$rest) if defined $rest;
1178 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1179 # Supply default value.
1185 die ("GetOpt::Long internal error (Can't happen)\n");
1190 $config_defaults = sub {
1191 # Handle POSIX compliancy.
1192 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
1193 $gen_prefix = "(--|-)";
1194 $autoabbrev = 0; # no automatic abbrev of options
1195 $bundling = 0; # no bundling of single letter switches
1196 $getopt_compat = 0; # disallow '+' to start options
1197 $order = $REQUIRE_ORDER;
1200 $gen_prefix = "(--|-|\\+)";
1201 $autoabbrev = 1; # automatic abbrev of options
1202 $bundling = 0; # bundling off by default
1203 $getopt_compat = 1; # allow '+' to start options
1206 # Other configurable settings.
1207 $debug = 0; # for debugging
1208 $error = 0; # error tally
1209 $ignorecase = 1; # ignore case when matching options
1210 $passthrough = 0; # leave unrecognized options alone
1213 ################ Initialization ################
1215 # Values for $order. See GNU getopt.c for details.
1216 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
1217 # Version major/minor numbers.
1218 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
1221 &$config_defaults ();
1223 ################ Package return ################