1 # GetOpt::Long.pm -- Universal options parsing
5 # RCS Status : $Id: GetoptLong.pl,v 2.22 2000-03-05 21:08:03+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 5 21:08:55 2000
13 ################ Copyright ################
15 # This program is Copyright 1990,2000 by Johan Vromans.
16 # This program is free software; you can redistribute it and/or
17 # modify it under the terms of the Perl Artistic License or the
18 # GNU General Public License as published by the Free Software
19 # Foundation; either version 2 of the License, or (at your option) any
22 # This program is distributed in the hope that it will be useful,
23 # but WITHOUT ANY WARRANTY; without even the implied warranty of
24 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 # GNU General Public License for more details.
27 # If you do not have a copy of the GNU General Public License write to
28 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
31 ################ Module Preamble ################
38 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
42 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
45 use AutoLoader qw(AUTOLOAD);
48 # User visible variables.
49 use vars @EXPORT, @EXPORT_OK;
50 use vars qw($error $debug $major_version $minor_version);
51 # Deprecated visible variables.
52 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
54 # Official invisible variables.
55 use vars qw($genprefix $caller);
59 sub config (@); # deprecated name
62 # Private subroutines.
63 sub ConfigDefaults ();
64 sub FindOption ($$$$$$$);
65 sub Croak (@); # demand loading the real Croak
67 ################ Local Variables ################
69 ################ Resident subroutines ################
71 sub ConfigDefaults () {
72 # Handle POSIX compliancy.
73 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
74 $genprefix = "(--|-)";
75 $autoabbrev = 0; # no automatic abbrev of options
76 $bundling = 0; # no bundling of single letter switches
77 $getopt_compat = 0; # disallow '+' to start options
78 $order = $REQUIRE_ORDER;
81 $genprefix = "(--|-|\\+)";
82 $autoabbrev = 1; # automatic abbrev of options
83 $bundling = 0; # bundling off by default
84 $getopt_compat = 1; # allow '+' to start options
87 # Other configurable settings.
88 $debug = 0; # for debugging
89 $error = 0; # error tally
90 $ignorecase = 1; # ignore case when matching options
91 $passthrough = 0; # leave unrecognized options alone
94 ################ Initialization ################
96 # Values for $order. See GNU getopt.c for details.
97 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
98 # Version major/minor numbers.
99 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
103 ################ Object Oriented routines ################
107 # NOTE: The object oriented routines use $error for thread locking.
108 eval "sub lock{}" if $] < 5.005;
110 # Store a copy of the default configuration. Since ConfigDefaults has
111 # just been called, what we get from Configure is the default.
112 my $default_config = do { lock ($error); Configure () };
116 my $class = ref($that) || $that;
118 # Register the callers package.
119 my $self = { caller => (caller)[0] };
121 bless ($self, $class);
123 # Process construct time configuration.
126 my $save = Configure ($default_config, @_);
127 $self->{settings} = Configure ($save);
129 # Else use default config.
131 $self->{settings} = $default_config;
142 # Restore settings, merge new settings in.
143 my $save = Configure ($self->{settings}, @_);
145 # Restore orig config and save the new config.
146 $self->{settings} = Configure ($save);
154 # Restore config settings.
155 my $save = Configure ($self->{settings});
159 $caller = $self->{caller};
160 eval { $ret = GetOptions (@_); };
162 # Restore saved settings.
165 # Handle errors and return value.
172 ################ Package return ################
178 ################ AutoLoading subroutines ################
180 # RCS Status : $Id: GetoptLongAl.pl,v 2.25 2000-03-05 21:08:03+01 jv Exp $
181 # Author : Johan Vromans
182 # Created On : Fri Mar 27 11:50:30 1998
183 # Last Modified By: Johan Vromans
184 # Last Modified On: Sat Mar 4 16:33:02 2000
190 my @optionlist = @_; # local copy of the option descriptions
191 my $argend = '--'; # option list terminator
192 my %opctl = (); # table of arg.specs (long and abbrevs)
193 my %bopctl = (); # table of arg.specs (bundles)
194 my $pkg = $caller || (caller)[0]; # current context
195 # Needed if linkage is omitted.
196 my %aliases= (); # alias table
197 my @ret = (); # accum for non-options
198 my %linkage; # linkage
199 my $userlinkage; # user supplied HASH
200 my $opt; # current option
201 my $genprefix = $genprefix; # so we can call the same module many times
202 my @opctl; # the possible long option names
206 print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
207 "called from package \"$pkg\".",
209 'GetOptionsAl $Revision: 2.25 $ ',
213 "autoabbrev=$autoabbrev,".
214 "bundling=$bundling,",
215 "getopt_compat=$getopt_compat,",
218 "ignorecase=$ignorecase,",
219 "passthrough=$passthrough,",
220 "genprefix=\"$genprefix\".",
224 # Check for ref HASH as first argument.
225 # First argument may be an object. It's OK to use this as long
226 # as it is really a hash underneath.
227 $userlinkage = undef;
228 if ( ref($optionlist[0]) and
229 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
230 $userlinkage = shift (@optionlist);
231 print STDERR ("=> user linkage: $userlinkage\n") if $debug;
234 # See if the first element of the optionlist contains option
235 # starter characters.
236 # Be careful not to interpret '<>' as option starters.
237 if ( $optionlist[0] =~ /^\W+$/
238 && !($optionlist[0] eq '<>'
240 && ref($optionlist[1])) ) {
241 $genprefix = shift (@optionlist);
242 # Turn into regexp. Needs to be parenthesized!
243 $genprefix =~ s/(\W)/\\$1/g;
244 $genprefix = "([" . $genprefix . "])";
247 # Verify correctness of optionlist.
250 while ( @optionlist > 0 ) {
251 my $opt = shift (@optionlist);
253 # Strip leading prefix so people can specify "--foo=i" if they like.
254 $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
256 if ( $opt eq '<>' ) {
257 if ( (defined $userlinkage)
258 && !(@optionlist > 0 && ref($optionlist[0]))
259 && (exists $userlinkage->{$opt})
260 && ref($userlinkage->{$opt}) ) {
261 unshift (@optionlist, $userlinkage->{$opt});
263 unless ( @optionlist > 0
264 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
265 $error .= "Option spec <> requires a reference to a subroutine\n";
268 $linkage{'<>'} = shift (@optionlist);
272 # Match option spec. Allow '?' as an alias.
273 if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
274 $error .= "Error in option spec: \"$opt\"\n";
277 my ($o, $c, $a) = ($1, $5);
278 $c = '' unless defined $c;
280 if ( ! defined $o ) {
281 # empty -> '-' option
282 $opctl{$o = ''} = $c;
286 my @o = split (/\|/, $o);
287 my $linko = $o = $o[0];
288 # Force an alias if the option name is not locase.
289 $a = $o unless $o eq lc($o);
293 && ($bundling ? length($o) > 1 : 1));
296 if ( $bundling && length($_) == 1 ) {
297 $_ = lc ($_) if $ignorecase > 1;
300 warn ("Ignoring '!' modifier for short option $_\n");
303 $opctl{$_} = $bopctl{$_} = $c;
306 $_ = lc ($_) if $ignorecase;
325 # If no linkage is supplied in the @optionlist, copy it from
326 # the userlinkage if available.
327 if ( defined $userlinkage ) {
328 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
329 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
330 print STDERR ("=> found userlinkage for \"$o\": ",
331 "$userlinkage->{$o}\n")
333 unshift (@optionlist, $userlinkage->{$o});
336 # Do nothing. Being undefined will be handled later.
342 # Copy the linkage. If omitted, link to global variable.
343 if ( @optionlist > 0 && ref($optionlist[0]) ) {
344 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
346 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
347 $linkage{$o} = shift (@optionlist);
349 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
350 $linkage{$o} = shift (@optionlist);
352 if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
354 if $bundling and defined $bopctl{$o} and
355 $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
357 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
358 $linkage{$o} = shift (@optionlist);
360 if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
362 if $bundling and defined $bopctl{$o} and
363 $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
366 $error .= "Invalid option linkage for \"$opt\"\n";
370 # Link to global $opt_XXX variable.
371 # Make sure a valid perl identifier results.
375 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
377 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
379 elsif ( $c =~ /%/ ) {
380 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
382 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
385 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
387 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
392 # Bail out if errors found.
393 die ($error) if $error;
396 # Sort the possible long option names.
397 @opctl = sort(keys (%opctl)) if $autoabbrev;
399 # Show the options tables if debugging.
403 while ( ($k,$v) = each(%opctl) ) {
404 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
408 while ( ($k,$v) = each(%bopctl) ) {
409 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
414 # Process argument list
416 while ( $goon && @ARGV > 0 ) {
418 #### Get next argument ####
420 $opt = shift (@ARGV);
421 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
423 #### Determine what we have ####
425 # Double dash is option list terminator.
426 if ( $opt eq $argend ) {
427 # Finish. Push back accumulated arguments and return.
428 unshift (@ARGV, @ret)
429 if $order == $PERMUTE;
430 return ($error == 0);
434 my $found; # success status
435 my $dsttype; # destination type ('@' or '%')
436 my $incr; # destination increment
437 my $key; # key (if hash type)
438 my $arg; # option argument
440 ($found, $opt, $arg, $dsttype, $incr, $key) =
441 FindOption ($genprefix, $argend, $opt,
442 \%opctl, \%bopctl, \@opctl, \%aliases);
446 # FindOption undefines $opt in case of errors.
447 next unless defined $opt;
449 if ( defined $arg ) {
450 $opt = $aliases{$opt} if defined $aliases{$opt};
452 if ( defined $linkage{$opt} ) {
453 print STDERR ("=> ref(\$L{$opt}) -> ",
454 ref($linkage{$opt}), "\n") if $debug;
456 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
458 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
460 if ( defined ${$linkage{$opt}} ) {
461 ${$linkage{$opt}} += $arg;
464 ${$linkage{$opt}} = $arg;
468 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
470 ${$linkage{$opt}} = $arg;
473 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
474 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
476 push (@{$linkage{$opt}}, $arg);
478 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
479 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
481 $linkage{$opt}->{$key} = $arg;
483 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
484 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
488 &{$linkage{$opt}}($opt, $arg);
490 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
491 if ( $@ =~ /^FINISH\b/ ) {
500 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
502 Croak ("Getopt::Long -- internal error!\n");
505 # No entry in linkage means entry in userlinkage.
506 elsif ( $dsttype eq '@' ) {
507 if ( defined $userlinkage->{$opt} ) {
508 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
510 push (@{$userlinkage->{$opt}}, $arg);
513 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
515 $userlinkage->{$opt} = [$arg];
518 elsif ( $dsttype eq '%' ) {
519 if ( defined $userlinkage->{$opt} ) {
520 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
522 $userlinkage->{$opt}->{$key} = $arg;
525 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
527 $userlinkage->{$opt} = {$key => $arg};
532 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
534 if ( defined $userlinkage->{$opt} ) {
535 $userlinkage->{$opt} += $arg;
538 $userlinkage->{$opt} = $arg;
542 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
543 $userlinkage->{$opt} = $arg;
549 # Not an option. Save it if we $PERMUTE and don't have a <>.
550 elsif ( $order == $PERMUTE ) {
551 # Try non-options call-back.
553 if ( (defined ($cb = $linkage{'<>'})) ) {
558 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
559 if ( $@ =~ /^FINISH\b/ ) {
568 print STDERR ("=> saving \"$tryopt\" ",
569 "(not an option, may permute)\n") if $debug;
570 push (@ret, $tryopt);
575 # ...otherwise, terminate.
577 # Push this one back and exit.
578 unshift (@ARGV, $tryopt);
579 return ($error == 0);
585 if ( $order == $PERMUTE ) {
586 # Push back accumulated arguments
587 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
588 if $debug && @ret > 0;
589 unshift (@ARGV, @ret) if @ret > 0;
592 return ($error == 0);
596 sub FindOption ($$$$$$$) {
598 # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
599 # returns (0) otherwise.
601 my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
602 my $key; # hash key for a hash option
605 print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
607 return (0) unless $opt =~ /^$prefix(.*)$/s;
612 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
614 my $optarg = undef; # value supplied with --opt=value
615 my $rest = undef; # remainder from unbundling
617 # If it is a long option, it may include the value.
618 if (($starter eq "--" || ($getopt_compat && !$bundling))
619 && $opt =~ /^([^=]+)=(.*)$/s ) {
622 print STDERR ("=> option \"", $opt,
623 "\", optarg = \"$optarg\"\n") if $debug;
628 my $tryopt = $opt; # option to try
629 my $optbl = $opctl; # table to look it up (long names)
634 if ( $bundling && $starter eq '-' ) {
635 # Unbundle single letter option.
636 $rest = substr ($tryopt, 1);
637 $tryopt = substr ($tryopt, 0, 1);
638 $tryopt = lc ($tryopt) if $ignorecase > 1;
639 print STDERR ("=> $starter$tryopt unbundled from ",
640 "$starter$tryopt$rest\n") if $debug;
641 $rest = undef unless $rest ne '';
642 $optbl = $bopctl; # look it up in the short names table
644 # If bundling == 2, long options can override bundles.
645 if ( $bundling == 2 and
647 defined ($type = $opctl->{$tryopt.$rest}) ) {
648 print STDERR ("=> $starter$tryopt rebundled to ",
649 "$starter$tryopt$rest\n") if $debug;
655 # Try auto-abbreviation.
656 elsif ( $autoabbrev ) {
657 # Downcase if allowed.
658 $tryopt = $opt = lc ($opt) if $ignorecase;
659 # Turn option name into pattern.
660 my $pat = quotemeta ($opt);
661 # Look up in option names.
662 my @hits = grep (/^$pat/, @{$names});
663 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
664 "out of ", scalar(@{$names}), "\n") if $debug;
666 # Check for ambiguous results.
667 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
668 # See if all matches are for the same option.
671 $_ = $aliases->{$_} if defined $aliases->{$_};
674 # Now see if it really is ambiguous.
675 unless ( keys(%hit) == 1 ) {
676 return (0) if $passthrough;
677 warn ("Option ", $opt, " is ambiguous (",
678 join(", ", @hits), ")\n");
681 return (1, $opt,$arg,$dsttype,$incr,$key);
686 # Complete the option name, if appropriate.
687 if ( @hits == 1 && $hits[0] ne $opt ) {
689 $tryopt = lc ($tryopt) if $ignorecase;
690 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
695 # Map to all lowercase if ignoring case.
696 elsif ( $ignorecase ) {
700 # Check validity by fetching the info.
701 $type = $optbl->{$tryopt} unless defined $type;
702 unless ( defined $type ) {
703 return (0) if $passthrough;
704 warn ("Unknown option: ", $opt, "\n");
706 return (1, $opt,$arg,$dsttype,$incr,$key);
710 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
712 #### Determine argument status ####
714 # If it is an option w/o argument, we're almost finished with it.
715 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
716 if ( defined $optarg ) {
717 return (0) if $passthrough;
718 warn ("Option ", $opt, " does not take an argument\n");
722 elsif ( $type eq '' || $type eq '+' ) {
723 $arg = 1; # supply explicit value
724 $incr = $type eq '+';
727 substr ($opt, 0, 2) = ''; # strip NO prefix
728 $arg = 0; # supply explicit value
730 unshift (@ARGV, $starter.$rest) if defined $rest;
731 return (1, $opt,$arg,$dsttype,$incr,$key);
734 # Get mandatory status and type info.
736 ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
738 # Check if there is an option argument available.
739 if ( defined $optarg ? ($optarg eq '')
740 : !(defined $rest || @ARGV > 0) ) {
741 # Complain if this option needs an argument.
742 if ( $mand eq "=" ) {
743 return (0) if $passthrough;
744 warn ("Option ", $opt, " requires an argument\n");
748 if ( $mand eq ":" ) {
749 $arg = $type eq "s" ? '' : 0;
751 return (1, $opt,$arg,$dsttype,$incr,$key);
754 # Get (possibly optional) argument.
755 $arg = (defined $rest ? $rest
756 : (defined $optarg ? $optarg : shift (@ARGV)));
758 # Get key if this is a "name=value" pair for a hash option.
760 if ($dsttype eq '%' && defined $arg) {
761 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
764 #### Check if the argument is valid for this option ####
766 if ( $type eq "s" ) { # string
767 # A mandatory string takes anything.
768 return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
770 # An optional string takes almost anything.
771 return (1, $opt,$arg,$dsttype,$incr,$key)
772 if defined $optarg || defined $rest;
773 return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
775 # Check for option or option list terminator.
776 if ($arg eq $argend ||
777 $arg =~ /^$prefix.+/) {
779 unshift (@ARGV, $arg);
780 # Supply empty value.
785 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
786 if ( $bundling && defined $rest && $rest =~ /^([-+]?[0-9]+)(.*)$/s ) {
789 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
791 elsif ( $arg !~ /^[-+]?[0-9]+$/ ) {
792 if ( defined $optarg || $mand eq "=" ) {
793 if ( $passthrough ) {
794 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
795 unless defined $optarg;
798 warn ("Value \"", $arg, "\" invalid for option ",
799 $opt, " (number expected)\n");
803 unshift (@ARGV, $starter.$rest) if defined $rest;
807 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
808 # Supply default value.
814 elsif ( $type eq "f" ) { # real number, int is also ok
815 # We require at least one digit before a point or 'e',
816 # and at least one digit following the point and 'e'.
818 if ( $bundling && defined $rest &&
819 $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
822 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
824 elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
825 if ( defined $optarg || $mand eq "=" ) {
826 if ( $passthrough ) {
827 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
828 unless defined $optarg;
831 warn ("Value \"", $arg, "\" invalid for option ",
832 $opt, " (real number expected)\n");
836 unshift (@ARGV, $starter.$rest) if defined $rest;
840 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
841 # Supply default value.
847 Croak ("GetOpt::Long internal error (Can't happen)\n");
849 return (1, $opt, $arg, $dsttype, $incr, $key);
852 # Getopt::Long Configuration.
857 [ $error, $debug, $major_version, $minor_version,
858 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
859 $passthrough, $genprefix ];
861 if ( ref($options[0]) eq 'ARRAY' ) {
862 ( $error, $debug, $major_version, $minor_version,
863 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
864 $passthrough, $genprefix ) = @{shift(@options)};
868 foreach $opt ( @options ) {
871 if ( $try =~ /^no_?(.*)$/s ) {
875 if ( $try eq 'default' or $try eq 'defaults' ) {
876 ConfigDefaults () if $action;
878 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
879 $autoabbrev = $action;
881 elsif ( $try eq 'getopt_compat' ) {
882 $getopt_compat = $action;
884 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
885 $ignorecase = $action;
887 elsif ( $try eq 'ignore_case_always' ) {
888 $ignorecase = $action ? 2 : 0;
890 elsif ( $try eq 'bundling' ) {
893 elsif ( $try eq 'bundling_override' ) {
894 $bundling = $action ? 2 : 0;
896 elsif ( $try eq 'require_order' ) {
897 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
899 elsif ( $try eq 'permute' ) {
900 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
902 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
903 $passthrough = $action;
905 elsif ( $try =~ /^prefix=(.+)$/ ) {
907 # Turn into regexp. Needs to be parenthesized!
908 $genprefix = "(" . quotemeta($genprefix) . ")";
909 eval { '' =~ /$genprefix/; };
910 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
912 elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
914 # Parenthesize if needed.
915 $genprefix = "(" . $genprefix . ")"
916 unless $genprefix =~ /^\(.*\)$/;
917 eval { '' =~ /$genprefix/; };
918 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
920 elsif ( $try eq 'debug' ) {
924 Croak ("Getopt::Long: unknown config parameter \"$opt\"")
935 # To prevent Carp from being loaded unnecessarily.
938 $Carp::CarpLevel = 1;
942 ################ Documentation ################
946 Getopt::Long - Extended processing of command line options
951 $result = GetOptions (...option-descriptions...);
955 The Getopt::Long module implements an extended getopt function called
956 GetOptions(). This function adheres to the POSIX syntax for command
957 line options, with GNU extensions. In general, this means that options
958 have long names instead of single letters, and are introduced with a
959 double dash "--". Support for bundling of command line options, as was
960 the case with the more traditional single-letter approach, is provided
961 but not enabled by default.
963 =head1 Command Line Options, an Introduction
965 Command line operated programs traditionally take their arguments from
966 the command line, for example filenames or other information that the
967 program needs to know. Besides arguments, these programs often take
968 command line I<options> as well. Options are not necessary for the
969 program to work, hence the name 'option', but are used to modify its
970 default behaviour. For example, a program could do its job quietly,
971 but with a suitable option it could provide verbose information about
974 Command line options come in several flavours. Historically, they are
975 preceded by a single dash C<->, and consist of a single letter.
979 Usually, these single-character options can be bundled:
983 Options can have values, the value is placed after the option
984 character. Sometimes with whitespace in between, sometimes not:
988 Due to the very cryptic nature of these options, another style was
989 developed that used long names. So instead of a cryptic C<-l> one
990 could use the more descriptive C<--long>. To distinguish between a
991 bundle of single-character options and a long one, two dashes are used
992 to precede the option name. Early implementations of long options used
993 a plus C<+> instead. Also, option values could be specified either
1002 The C<+> form is now obsolete and strongly deprecated.
1004 =head1 Getting Started with Getopt::Long
1006 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
1007 the firs Perl module that provided support for handling the new style
1008 of command line options, hence the name Getopt::Long. This module
1009 also supports single-character options and bundling. In this case, the
1010 options are restricted to alphabetic characters only, and the
1011 characters C<?> and C<->.
1013 To use Getopt::Long from a Perl program, you must include the
1014 following line in your Perl program:
1018 This will load the core of the Getopt::Long module and prepare your
1019 program for using it. Most of the actual Getopt::Long code is not
1020 loaded until you really call one of its functions.
1022 In the default configuration, options names may be abbreviated to
1023 uniqueness, case does not matter, and a single dash is sufficient,
1024 even for long option names. Also, options may be placed between
1025 non-option arguments. See L<Configuring Getopt::Long> for more
1026 details on how to configure Getopt::Long.
1028 =head2 Simple options
1030 The most simple options are the ones that take no values. Their mere
1031 presence on the command line enables the option. Popular examples are:
1033 --all --verbose --quiet --debug
1035 Handling simple options is straightforward:
1037 my $verbose = ''; # option variable with default value (false)
1038 my $all = ''; # option variable with default value (false)
1039 GetOptions ('verbose' => \$verbose, 'all' => \$all);
1041 The call to GetOptions() parses the command line arguments that are
1042 present in C<@ARGV> and sets the option variable to the value C<1> if
1043 the option did occur on the command line. Otherwise, the option
1044 variable is not touched. Setting the option value to true is often
1045 called I<enabling> the option.
1047 The option name as specified to the GetOptions() function is called
1048 the option I<specification>. Later we'll see that this specification
1049 can contain more than just the option name. The reference to the
1050 variable is called the option I<destination>.
1052 GetOptions() will return a true value if the command line could be
1053 processed successfully. Otherwise, it will write error messages to
1054 STDERR, and return a false result.
1056 =head2 A little bit less simple options
1058 Getopt::Long supports two useful variants of simple options:
1059 I<negatable> options and I<incremental> options.
1061 A negatable option is specified with a exclamation mark C<!> after the
1064 my $verbose = ''; # option variable with default value (false)
1065 GetOptions ('verbose!' => \$verbose);
1067 Now, using C<--verbose> on the command line will enable C<$verbose>,
1068 as expected. But it is also allowed to use C<--noverbose>, which will
1069 disable C<$verbose> by setting its value to C<0>. Using a suitable
1070 default value, the program can find out whether C<$verbose> is false
1071 by default, or disabled by using C<--noverbose>.
1073 An incremental option is specified with a plus C<+> after the
1076 my $verbose = ''; # option variable with default value (false)
1077 GetOptions ('verbose+' => \$verbose);
1079 Using C<--verbose> on the command line will increment the value of
1080 C<$verbose>. This way the program can keep track of how many times the
1081 option occurred on the command line. For example, each occurrence of
1082 C<--verbose> could increase the verbosity level of the program.
1084 =head2 Mixing command line option with other arguments
1086 Usually programs take command line options as well as other arguments,
1087 for example, file names. It is good practice to always specify the
1088 options first, and the other arguments last. Getopt::Long will,
1089 however, allow the options and arguments to be mixed and 'filter out'
1090 all the options before passing the rest of the arguments to the
1091 program. To stop Getopt::Long from processing further arguments,
1092 insert a double dash C<--> on the command line:
1096 In this example, C<--all> will I<not> be treated as an option, but
1097 passed to the program unharmed, in C<@ARGV>.
1099 =head2 Options with values
1101 For options that take values it must be specified whether the option
1102 value is required or not, and what kind of value the option expects.
1104 Three kinds of values are supported: integer numbers, floating point
1105 numbers, and strings.
1107 If the option value is required, Getopt::Long will take the
1108 command line argument that follows the option and assign this to the
1109 option variable. If, however, the option value is specified as
1110 optional, this will only be done if that value does not look like a
1111 valid command line option itself.
1113 my $tag = ''; # option variable with default value
1114 GetOptions ('tag=s' => \$tag);
1116 In the option specification, the option name is followed by an equals
1117 sign C<=> and the letter C<s>. The equals sign indicates that this
1118 option requires a value. The letter C<s> indicates that this value is
1119 an arbitrary string. Other possible value types are C<i> for integer
1120 values, and C<f> for floating point values. Using a colon C<:> instead
1121 of the equals sign indicates that the option value is optional. In
1122 this case, if no suitable value is supplied, string valued options get
1123 an empty string C<''> assigned, while numeric options are set to C<0>.
1125 =head2 Options with multiple values
1127 Options sometimes take several values. For example, a program could
1128 use multiple directories to search for library files:
1130 --library lib/stdlib --library lib/extlib
1132 To accomplish this behaviour, simply specify an array reference as the
1133 destination for the option:
1136 GetOptions ("library=s" => \@libfiles);
1138 Used with the example above, C<@libfiles> would contain two strings
1139 upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
1140 It is also possible to specify that only integer or floating point
1141 numbers are acceptible values.
1143 Often it is useful to allow comma-separated lists of values as well as
1144 multiple occurrences of the options. This is easy using Perl's split()
1145 and join() operators:
1148 GetOptions ("library=s" => \@libfiles);
1149 @libfiles = split(/,/,join(',',@libfiles));
1151 Of course, it is important to choose the right separator string for
1154 =head2 Options with hash values
1156 If the option destination is a reference to a hash, the option will
1157 take, as value, strings of the form I<key>C<=>I<value>. The value will
1158 be stored with the specified key in the hash.
1161 GetOptions ("define=s" => \%defines);
1163 When used with command line options:
1165 --define os=linux --define vendor=redhat
1167 the hash C<%defines> will contain two keys, C<"os"> with value
1168 C<"linux> and C<"vendor"> with value C<"redhat">.
1169 It is also possible to specify that only integer or floating point
1170 numbers are acceptible values. The keys are always taken to be strings.
1172 =head2 User-defined subroutines to handle options
1174 Ultimate control over what should be done when (actually: each time)
1175 an option is encountered on the command line can be achieved by
1176 designating a reference to a subroutine (or an anonymous subroutine)
1177 as the option destination. When GetOptions() encounters the option, it
1178 will call the subroutine with two arguments: the name of the option,
1179 and the value to be assigned. It is up to the subroutine to store the
1180 value, or do whatever it thinks is appropriate.
1182 A trivial application of this mechanism is to implement options that
1183 are related to each other. For example:
1185 my $verbose = ''; # option variable with default value (false)
1186 GetOptions ('verbose' => \$verbose,
1187 'quiet' => sub { $verbose = 0 });
1189 Here C<--verbose> and C<--quiet> control the same variable
1190 C<$verbose>, but with opposite values.
1192 If the subroutine needs to signal an error, it should call die() with
1193 the desired error message as its argument. GetOptions() will catch the
1194 die(), issue the error message, and record that an error result must
1195 be returned upon completion.
1197 It is also possible for a user-defined subroutine to preliminary
1198 terminate options processing by calling die() with argument
1199 C<"FINISH">. GetOptions will react as if it encountered a double dash
1202 =head2 Options with multiple names
1204 Often it is user friendly to supply alternate mnemonic names for
1205 options. For example C<--height> could be an alternate name for
1206 C<--length>. Alternate names can be included in the option
1207 specification, separated by vertical bar C<|> characters. To implement
1210 GetOptions ('length|height=f' => \$length);
1212 The first name is called the I<primary> name, the other names are
1215 Multiple alternate names are possible.
1217 =head2 Case and abbreviations
1219 Without additional configuration, GetOptions() will ignore the case of
1220 option names, and allow the options to be abbreviated to uniqueness.
1222 GetOptions ('length|height=f' => \$length, "head" => \$head);
1224 This call will allow C<--l> and C<--L> for the length option, but
1225 requires a least C<--hea> and C<--hei> for the head and height options.
1227 =head2 Summary of Option Specifications
1229 Each option specifier consists of two parts: the name specification
1230 and the argument specification.
1232 The name specification contains the name of the option, optionally
1233 followed by a list of alternative names separated by vertical bar
1236 length option name is "length"
1237 length|size|l name is "length", aliases are "size" and "l"
1239 The argument specification is optional. If omitted, the option is
1240 considered boolean, a value of 1 will be assigned when the option is
1241 used on the command line.
1243 The argument specification can be
1249 The option does not take an argument and may be negated, i.e. prefixed
1250 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
1251 assigned) and C<--nofoo> (a value of 0 will be assigned).
1255 The option does not take an argument and will be incremented by 1
1256 every time it appears on the command line. E.g. C<"more+">, when used
1257 with C<--more --more --more>, will increment the value three times,
1258 resulting in a value of 3 (provided it was 0 or undefined at first).
1260 The C<+> specifier is ignored if the option destination is not a scalar.
1262 =item = I<type> [ I<desttype> ]
1264 The option requires an argument of the given type. Supported types
1271 String. An arbitrary sequence of characters. It is valid for the
1272 argument to start with C<-> or C<-->.
1276 Integer. An optional leading plus or minus sign, followed by a
1281 Real number. For example C<3.14>, C<-6.23E24> and so on.
1285 The I<desttype> can be C<@> or C<%> to specify that the option is
1286 list or a hash valued. This is only needed when the destination for
1287 the option value is not otherwise specified. It should be omitted when
1290 =item : I<type> [ I<desttype> ]
1292 Like C<=>, but designates the argument as optional.
1293 If omitted, an empty string will be assigned to string values options,
1294 and the value zero to numeric options.
1296 Note that if a string argument starts with C<-> or C<-->, it will be
1297 considered an option on itself.
1301 =head1 Advanced Possibilities
1303 =head2 Documentation and help texts
1305 Getopt::Long encourages the use of Pod::Usage to produce help
1306 messages. For example:
1314 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1315 pod2usage(1) if $help;
1316 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
1322 sample - Using GetOpt::Long and Pod::Usage
1326 sample [options] [file ...]
1329 -help brief help message
1330 -man full documentation
1338 Print a brief help message and exits.
1342 Prints the manual page and exits.
1348 B<This program> will read the given input file(s) and do someting
1349 useful with the contents thereof.
1353 See L<Pod::Usage> for details.
1355 =head2 Storing options in a hash
1357 Sometimes, for example when there are a lot of options, having a
1358 separate variable for each of them can be cumbersome. GetOptions()
1359 supports, as an alternative mechanism, storing options in a hash.
1361 To obtain this, a reference to a hash must be passed I<as the first
1362 argument> to GetOptions(). For each option that is specified on the
1363 command line, the option value will be stored in the hash with the
1364 option name as key. Options that are not actually used on the command
1365 line will not be put in the hash, on other words,
1366 C<exists($h{option})> (or defined()) can be used to test if an option
1367 was used. The drawback is that warnings will be issued if the program
1368 runs under C<use strict> and uses C<$h{option}> without testing with
1369 exists() or defined() first.
1372 GetOptions (\%h, 'length=i'); # will store in $h{length}
1374 For options that take list or hash values, it is necessary to indicate
1375 this by appending an C<@> or C<%> sign after the type:
1377 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
1379 To make things more complicated, the hash may contain references to
1380 the actual destinations, for example:
1383 my %h = ('length' => \$len);
1384 GetOptions (\%h, 'length=i'); # will store in $len
1386 This example is fully equivalent with:
1389 GetOptions ('length=i' => \$len); # will store in $len
1391 Any mixture is possible. For example, the most frequently used options
1392 could be stored in variables while all other options get stored in the
1395 my $verbose = 0; # frequently referred
1396 my $debug = 0; # frequently referred
1397 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1398 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1399 if ( $verbose ) { ... }
1400 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
1404 With bundling it is possible to set several single-character options
1405 at once. For example if C<a>, C<v> and C<x> are all valid options,
1409 would set all three.
1411 Getopt::Long supports two levels of bundling. To enable bundling, a
1412 call to Getopt::Long::Configure is required.
1414 The first level of bundling can be enabled with:
1416 Getopt::Long::Configure ("bundling");
1418 Configured this way, single-character options can be bundled but long
1419 options B<must> always start with a double dash C<--> to avoid
1420 abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1425 would set C<a>, C<v> and C<x>, but
1431 The second level of bundling lifts this restriction. It can be enabled
1434 Getopt::Long::Configure ("bundling_override");
1436 Now, C<-vax> would set the option C<vax>.
1438 When any level of bundling is enabled, option values may be inserted
1439 in the bundle. For example:
1447 When configured for bundling, single-character options are matched
1448 case sensitive while long options are matched case insensitive. To
1449 have the single-character options matched case insensitive as well,
1452 Getopt::Long::Configure ("bundling", "ignorecase_always");
1454 It goes without saying that bundling can be quite confusing.
1456 =head2 The lonesome dash
1458 Some applications require the option C<-> (that's a lone dash). This
1459 can be achieved by adding an option specification with an empty name:
1461 GetOptions ('' => \$stdio);
1463 A lone dash on the command line will now be legal, and set options
1466 =head2 Argument call-back
1468 A special option 'name' C<<>> can be used to designate a subroutine
1469 to handle non-option arguments. When GetOptions() encounters an
1470 argument that does not look like an option, it will immediately call this
1471 subroutine and passes it the argument as a parameter.
1477 GetOptions ('width=i' => \$width, '<>' => \&process);
1479 When applied to the following command line:
1481 arg1 --width=72 arg2 --width=60 arg3
1484 C<process("arg1")> while C<$width> is C<80>,
1485 C<process("arg2")> while C<$width> is C<72>, and
1486 C<process("arg3")> while C<$width> is C<60>.
1488 This feature requires configuration option B<permute>, see section
1489 L<Configuring Getopt::Long>.
1492 =head1 Configuring Getopt::Long
1494 Getopt::Long can be configured by calling subroutine
1495 Getopt::Long::Configure(). This subroutine takes a list of quoted
1496 strings, each specifying a configuration option to be set, e.g.
1497 C<ignore_case>, or reset, e.g. C<no_ignore_case>. Case does not
1498 matter. Multiple calls to Configure() are possible.
1500 The following options are available:
1506 This option causes all configuration options to be reset to their
1511 Allow option names to be abbreviated to uniqueness.
1512 Default is set unless environment variable
1513 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is reset.
1517 Allow C<+> to start options.
1518 Default is set unless environment variable
1519 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is reset.
1523 Whether command line arguments are allowed to be mixed with options.
1524 Default is set unless environment variable
1525 POSIXLY_CORRECT has been set, in which case C<require_order> is reset.
1527 See also C<permute>, which is the opposite of C<require_order>.
1531 Whether command line arguments are allowed to be mixed with options.
1532 Default is set unless environment variable
1533 POSIXLY_CORRECT has been set, in which case C<permute> is reset.
1534 Note that C<permute> is the opposite of C<require_order>.
1536 If C<permute> is set, this means that
1538 --foo arg1 --bar arg2 arg3
1542 --foo --bar arg1 arg2 arg3
1544 If an argument call-back routine is specified, C<@ARGV> will always be
1545 empty upon succesful return of GetOptions() since all options have been
1546 processed. The only exception is when C<--> is used:
1548 --foo arg1 --bar arg2 -- arg3
1550 will call the call-back routine for arg1 and arg2, and terminate
1551 GetOptions() leaving C<"arg2"> in C<@ARGV>.
1553 If C<require_order> is set, options processing
1554 terminates when the first non-option is encountered.
1556 --foo arg1 --bar arg2 arg3
1560 --foo -- arg1 --bar arg2 arg3
1562 =item bundling (default: reset)
1564 Setting this option will allow single-character options to be bundled.
1565 To distinguish bundles from long option names, long options I<must> be
1566 introduced with C<--> and single-character options (and bundles) with
1569 Note: resetting C<bundling> also resets C<bundling_override>.
1571 =item bundling_override (default: reset)
1573 If C<bundling_override> is set, bundling is enabled as with
1574 C<bundling> but now long option names override option bundles.
1576 Note: resetting C<bundling_override> also resets C<bundling>.
1578 B<Note:> Using option bundling can easily lead to unexpected results,
1579 especially when mixing long options and bundles. Caveat emptor.
1581 =item ignore_case (default: set)
1583 If set, case is ignored when matching long option names. Single
1584 character options will be treated case-sensitive.
1586 Note: resetting C<ignore_case> also resets C<ignore_case_always>.
1588 =item ignore_case_always (default: reset)
1590 When bundling is in effect, case is ignored on single-character
1593 Note: resetting C<ignore_case_always> also resets C<ignore_case>.
1595 =item pass_through (default: reset)
1597 Options that are unknown, ambiguous or supplied with an invalid option
1598 value are passed through in C<@ARGV> instead of being flagged as
1599 errors. This makes it possible to write wrapper scripts that process
1600 only part of the user supplied command line arguments, and pass the
1601 remaining options to some other program.
1603 This can be very confusing, especially when C<permute> is also set.
1607 The string that starts options. If a constant string is not
1608 sufficient, see C<prefix_pattern>.
1610 =item prefix_pattern
1612 A Perl pattern that identifies the strings that introduce options.
1613 Default is C<(--|-|\+)> unless environment variable
1614 POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1616 =item debug (default: reset)
1618 Enable copious debugging output.
1622 =head1 Return values and Errors
1624 Configuration errors and errors in the option definitions are
1625 signalled using die() and will terminate the calling program unless
1626 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
1627 }>, or die() was trapped using C<$SIG{__DIE__}>.
1629 A return value of 1 (true) indicates success.
1631 A return status of 0 (false) indicates that the function detected one
1632 or more errors during option parsing. These errors are signalled using
1633 warn() and can be trapped with C<$SIG{__WARN__}>.
1635 Errors that can't happen are signalled using Carp::croak().
1639 The earliest development of C<newgetopt.pl> started in 1990, with Perl
1640 version 4. As a result, its development, and the development of
1641 Getopt::Long, has gone through several stages. Since backward
1642 compatibility has always been extremely important, the current version
1643 of Getopt::Long still supports a lot of constructs that nowadays are
1644 no longer necessary or otherwise unwanted. This section describes
1645 briefly some of these 'features'.
1647 =head2 Default destinations
1649 When no destination is specified for an option, GetOptions will store
1650 the resultant value in a global variable named C<opt_>I<XXX>, where
1651 I<XXX> is the primary name of this option. When a progam executes
1652 under C<use strict> (recommended), these variables must be
1653 pre-declared with our() or C<use vars>.
1655 our $opt_length = 0;
1656 GetOptions ('length=i'); # will store in $opt_length
1658 To yield a usable Perl variable, characters that are not part of the
1659 syntax for variables are translated to underscores. For example,
1660 C<--fpp-struct-return> will set the variable
1661 C<$opt_fpp_struct_return>. Note that this variable resides in the
1662 namespace of the calling program, not necessarily C<main>. For
1665 GetOptions ("size=i", "sizes=i@");
1667 with command line "-size 10 -sizes 24 -sizes 48" will perform the
1668 equivalent of the assignments
1671 @opt_sizes = (24, 48);
1673 =head2 Alternative option starters
1675 A string of alternative option starter characters may be passed as the
1676 first argument (or the first argument after a leading hash reference
1680 GetOptions ('/', 'length=i' => $len);
1682 Now the command line may look like:
1686 Note that to terminate options processing still requires a double dash
1689 GetOptions() will not interpret a leading C<"<>"> as option starters
1690 if the next argument is a reference. To force C<"<"> and C<">"> as
1691 option starters, use C<"><">. Confusing? Well, B<using a starter
1692 argument is strongly deprecated> anyway.
1694 =head2 Configuration variables
1696 Previous versions of Getopt::Long used variables for the purpose of
1697 configuring. Although manipulating these variables still work, it
1698 is strongly encouraged to use the new C<config> routine. Besides, it
1703 Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
1705 =head1 COPYRIGHT AND DISCLAIMER
1707 This program is Copyright 2000,1990 by Johan Vromans.
1708 This program is free software; you can redistribute it and/or
1709 modify it under the terms of the Perl Artistic License or the
1710 GNU General Public License as published by the Free Software
1711 Foundation; either version 2 of the License, or (at your option) any
1714 This program is distributed in the hope that it will be useful,
1715 but WITHOUT ANY WARRANTY; without even the implied warranty of
1716 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1717 GNU General Public License for more details.
1719 If you do not have a copy of the GNU General Public License write to
1720 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
1727 # eval: (load-file "pod.el")