1 # GetOpt::Long.pm -- Universal options parsing
5 # RCS Status : $Id: GetoptLong.pl,v 2.24 2000-03-14 21:28:52+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: Tue Mar 14 21:28:40 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 ################ Package return ################
109 ################ AutoLoading subroutines ################
111 # RCS Status : $Id: GetoptLongAl.pl,v 2.27 2000-03-17 09:07:26+01 jv Exp $
112 # Author : Johan Vromans
113 # Created On : Fri Mar 27 11:50:30 1998
114 # Last Modified By: Johan Vromans
115 # Last Modified On: Fri Mar 17 09:00:09 2000
121 my @optionlist = @_; # local copy of the option descriptions
122 my $argend = '--'; # option list terminator
123 my %opctl = (); # table of arg.specs (long and abbrevs)
124 my %bopctl = (); # table of arg.specs (bundles)
125 my $pkg = $caller || (caller)[0]; # current context
126 # Needed if linkage is omitted.
127 my %aliases= (); # alias table
128 my @ret = (); # accum for non-options
129 my %linkage; # linkage
130 my $userlinkage; # user supplied HASH
131 my $opt; # current option
132 my $genprefix = $genprefix; # so we can call the same module many times
133 my @opctl; # the possible long option names
137 print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
138 "called from package \"$pkg\".",
140 'GetOptionsAl $Revision: 2.27 $ ',
144 "autoabbrev=$autoabbrev,".
145 "bundling=$bundling,",
146 "getopt_compat=$getopt_compat,",
149 "ignorecase=$ignorecase,",
150 "passthrough=$passthrough,",
151 "genprefix=\"$genprefix\".",
155 # Check for ref HASH as first argument.
156 # First argument may be an object. It's OK to use this as long
157 # as it is really a hash underneath.
158 $userlinkage = undef;
159 if ( ref($optionlist[0]) and
160 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
161 $userlinkage = shift (@optionlist);
162 print STDERR ("=> user linkage: $userlinkage\n") if $debug;
165 # See if the first element of the optionlist contains option
166 # starter characters.
167 # Be careful not to interpret '<>' as option starters.
168 if ( $optionlist[0] =~ /^\W+$/
169 && !($optionlist[0] eq '<>'
171 && ref($optionlist[1])) ) {
172 $genprefix = shift (@optionlist);
173 # Turn into regexp. Needs to be parenthesized!
174 $genprefix =~ s/(\W)/\\$1/g;
175 $genprefix = "([" . $genprefix . "])";
178 # Verify correctness of optionlist.
181 while ( @optionlist > 0 ) {
182 my $opt = shift (@optionlist);
184 # Strip leading prefix so people can specify "--foo=i" if they like.
185 $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
187 if ( $opt eq '<>' ) {
188 if ( (defined $userlinkage)
189 && !(@optionlist > 0 && ref($optionlist[0]))
190 && (exists $userlinkage->{$opt})
191 && ref($userlinkage->{$opt}) ) {
192 unshift (@optionlist, $userlinkage->{$opt});
194 unless ( @optionlist > 0
195 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
196 $error .= "Option spec <> requires a reference to a subroutine\n";
199 $linkage{'<>'} = shift (@optionlist);
203 # Match option spec. Allow '?' as an alias.
204 if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
205 $error .= "Error in option spec: \"$opt\"\n";
208 my ($o, $c, $a) = ($1, $5);
209 $c = '' unless defined $c;
211 if ( ! defined $o ) {
212 # empty -> '-' option
213 $opctl{$o = ''} = $c;
217 my @o = split (/\|/, $o);
218 my $linko = $o = $o[0];
219 # Force an alias if the option name is not locase.
220 $a = $o unless $o eq lc($o);
224 && ($bundling ? length($o) > 1 : 1));
227 if ( $bundling && length($_) == 1 ) {
228 $_ = lc ($_) if $ignorecase > 1;
231 warn ("Ignoring '!' modifier for short option $_\n");
232 $opctl{$_} = $bopctl{$_} = '';
235 $opctl{$_} = $bopctl{$_} = $c;
239 $_ = lc ($_) if $ignorecase;
260 # If no linkage is supplied in the @optionlist, copy it from
261 # the userlinkage if available.
262 if ( defined $userlinkage ) {
263 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
264 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
265 print STDERR ("=> found userlinkage for \"$o\": ",
266 "$userlinkage->{$o}\n")
268 unshift (@optionlist, $userlinkage->{$o});
271 # Do nothing. Being undefined will be handled later.
277 # Copy the linkage. If omitted, link to global variable.
278 if ( @optionlist > 0 && ref($optionlist[0]) ) {
279 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
281 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
282 $linkage{$o} = shift (@optionlist);
284 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
285 $linkage{$o} = shift (@optionlist);
287 if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
289 if $bundling and defined $bopctl{$o} and
290 $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
292 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
293 $linkage{$o} = shift (@optionlist);
295 if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
297 if $bundling and defined $bopctl{$o} and
298 $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
301 $error .= "Invalid option linkage for \"$opt\"\n";
305 # Link to global $opt_XXX variable.
306 # Make sure a valid perl identifier results.
310 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
312 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
314 elsif ( $c =~ /%/ ) {
315 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
317 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
320 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
322 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
327 # Bail out if errors found.
328 die ($error) if $error;
331 # Sort the possible long option names.
332 @opctl = sort(keys (%opctl)) if $autoabbrev;
334 # Show the options tables if debugging.
338 while ( ($k,$v) = each(%opctl) ) {
339 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
343 while ( ($k,$v) = each(%bopctl) ) {
344 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
349 # Process argument list
351 while ( $goon && @ARGV > 0 ) {
353 #### Get next argument ####
355 $opt = shift (@ARGV);
356 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
358 #### Determine what we have ####
360 # Double dash is option list terminator.
361 if ( $opt eq $argend ) {
362 # Finish. Push back accumulated arguments and return.
363 unshift (@ARGV, @ret)
364 if $order == $PERMUTE;
365 return ($error == 0);
369 my $found; # success status
370 my $dsttype; # destination type ('@' or '%')
371 my $incr; # destination increment
372 my $key; # key (if hash type)
373 my $arg; # option argument
375 ($found, $opt, $arg, $dsttype, $incr, $key) =
376 FindOption ($genprefix, $argend, $opt,
377 \%opctl, \%bopctl, \@opctl, \%aliases);
381 # FindOption undefines $opt in case of errors.
382 next unless defined $opt;
384 if ( defined $arg ) {
385 $opt = $aliases{$opt} if defined $aliases{$opt};
387 if ( defined $linkage{$opt} ) {
388 print STDERR ("=> ref(\$L{$opt}) -> ",
389 ref($linkage{$opt}), "\n") if $debug;
391 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
393 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
395 if ( defined ${$linkage{$opt}} ) {
396 ${$linkage{$opt}} += $arg;
399 ${$linkage{$opt}} = $arg;
403 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
405 ${$linkage{$opt}} = $arg;
408 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
409 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
411 push (@{$linkage{$opt}}, $arg);
413 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
414 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
416 $linkage{$opt}->{$key} = $arg;
418 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
419 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
423 &{$linkage{$opt}}($opt, $arg);
425 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
427 if ( $@ =~ /^!FINISH\b/ ) {
437 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
439 Croak ("Getopt::Long -- internal error!\n");
442 # No entry in linkage means entry in userlinkage.
443 elsif ( $dsttype eq '@' ) {
444 if ( defined $userlinkage->{$opt} ) {
445 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
447 push (@{$userlinkage->{$opt}}, $arg);
450 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
452 $userlinkage->{$opt} = [$arg];
455 elsif ( $dsttype eq '%' ) {
456 if ( defined $userlinkage->{$opt} ) {
457 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
459 $userlinkage->{$opt}->{$key} = $arg;
462 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
464 $userlinkage->{$opt} = {$key => $arg};
469 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
471 if ( defined $userlinkage->{$opt} ) {
472 $userlinkage->{$opt} += $arg;
475 $userlinkage->{$opt} = $arg;
479 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
480 $userlinkage->{$opt} = $arg;
486 # Not an option. Save it if we $PERMUTE and don't have a <>.
487 elsif ( $order == $PERMUTE ) {
488 # Try non-options call-back.
490 if ( (defined ($cb = $linkage{'<>'})) ) {
495 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
497 if ( $@ =~ /^!FINISH\b/ ) {
507 print STDERR ("=> saving \"$tryopt\" ",
508 "(not an option, may permute)\n") if $debug;
509 push (@ret, $tryopt);
514 # ...otherwise, terminate.
516 # Push this one back and exit.
517 unshift (@ARGV, $tryopt);
518 return ($error == 0);
524 if ( $order == $PERMUTE ) {
525 # Push back accumulated arguments
526 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
527 if $debug && @ret > 0;
528 unshift (@ARGV, @ret) if @ret > 0;
531 return ($error == 0);
535 sub FindOption ($$$$$$$) {
537 # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
538 # returns (0) otherwise.
540 my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
541 my $key; # hash key for a hash option
544 print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
546 return (0) unless $opt =~ /^$prefix(.*)$/s;
551 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
553 my $optarg = undef; # value supplied with --opt=value
554 my $rest = undef; # remainder from unbundling
556 # If it is a long option, it may include the value.
557 if (($starter eq "--" || ($getopt_compat && !$bundling))
558 && $opt =~ /^([^=]+)=(.*)$/s ) {
561 print STDERR ("=> option \"", $opt,
562 "\", optarg = \"$optarg\"\n") if $debug;
567 my $tryopt = $opt; # option to try
568 my $optbl = $opctl; # table to look it up (long names)
573 if ( $bundling && $starter eq '-' ) {
574 # Unbundle single letter option.
575 $rest = substr ($tryopt, 1);
576 $tryopt = substr ($tryopt, 0, 1);
577 $tryopt = lc ($tryopt) if $ignorecase > 1;
578 print STDERR ("=> $starter$tryopt unbundled from ",
579 "$starter$tryopt$rest\n") if $debug;
580 $rest = undef unless $rest ne '';
581 $optbl = $bopctl; # look it up in the short names table
583 # If bundling == 2, long options can override bundles.
584 if ( $bundling == 2 and
586 defined ($type = $opctl->{$tryopt.$rest}) ) {
587 print STDERR ("=> $starter$tryopt rebundled to ",
588 "$starter$tryopt$rest\n") if $debug;
594 # Try auto-abbreviation.
595 elsif ( $autoabbrev ) {
596 # Downcase if allowed.
597 $tryopt = $opt = lc ($opt) if $ignorecase;
598 # Turn option name into pattern.
599 my $pat = quotemeta ($opt);
600 # Look up in option names.
601 my @hits = grep (/^$pat/, @{$names});
602 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
603 "out of ", scalar(@{$names}), "\n") if $debug;
605 # Check for ambiguous results.
606 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
607 # See if all matches are for the same option.
610 $_ = $aliases->{$_} if defined $aliases->{$_};
613 # Now see if it really is ambiguous.
614 unless ( keys(%hit) == 1 ) {
615 return (0) if $passthrough;
616 warn ("Option ", $opt, " is ambiguous (",
617 join(", ", @hits), ")\n");
620 return (1, $opt,$arg,$dsttype,$incr,$key);
625 # Complete the option name, if appropriate.
626 if ( @hits == 1 && $hits[0] ne $opt ) {
628 $tryopt = lc ($tryopt) if $ignorecase;
629 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
634 # Map to all lowercase if ignoring case.
635 elsif ( $ignorecase ) {
639 # Check validity by fetching the info.
640 $type = $optbl->{$tryopt} unless defined $type;
641 unless ( defined $type ) {
642 return (0) if $passthrough;
643 warn ("Unknown option: ", $opt, "\n");
645 return (1, $opt,$arg,$dsttype,$incr,$key);
649 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
651 #### Determine argument status ####
653 # If it is an option w/o argument, we're almost finished with it.
654 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
655 if ( defined $optarg ) {
656 return (0) if $passthrough;
657 warn ("Option ", $opt, " does not take an argument\n");
661 elsif ( $type eq '' || $type eq '+' ) {
662 $arg = 1; # supply explicit value
663 $incr = $type eq '+';
666 substr ($opt, 0, 2) = ''; # strip NO prefix
667 $arg = 0; # supply explicit value
669 unshift (@ARGV, $starter.$rest) if defined $rest;
670 return (1, $opt,$arg,$dsttype,$incr,$key);
673 # Get mandatory status and type info.
675 ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
677 # Check if there is an option argument available.
678 if ( defined $optarg ? ($optarg eq '')
679 : !(defined $rest || @ARGV > 0) ) {
680 # Complain if this option needs an argument.
681 if ( $mand eq "=" ) {
682 return (0) if $passthrough;
683 warn ("Option ", $opt, " requires an argument\n");
687 if ( $mand eq ":" ) {
688 $arg = $type eq "s" ? '' : 0;
690 return (1, $opt,$arg,$dsttype,$incr,$key);
693 # Get (possibly optional) argument.
694 $arg = (defined $rest ? $rest
695 : (defined $optarg ? $optarg : shift (@ARGV)));
697 # Get key if this is a "name=value" pair for a hash option.
699 if ($dsttype eq '%' && defined $arg) {
700 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
703 #### Check if the argument is valid for this option ####
705 if ( $type eq "s" ) { # string
706 # A mandatory string takes anything.
707 return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
709 # An optional string takes almost anything.
710 return (1, $opt,$arg,$dsttype,$incr,$key)
711 if defined $optarg || defined $rest;
712 return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
714 # Check for option or option list terminator.
715 if ($arg eq $argend ||
716 $arg =~ /^$prefix.+/) {
718 unshift (@ARGV, $arg);
719 # Supply empty value.
724 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
725 if ( $bundling && defined $rest && $rest =~ /^([-+]?[0-9]+)(.*)$/s ) {
728 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
730 elsif ( $arg !~ /^[-+]?[0-9]+$/ ) {
731 if ( defined $optarg || $mand eq "=" ) {
732 if ( $passthrough ) {
733 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
734 unless defined $optarg;
737 warn ("Value \"", $arg, "\" invalid for option ",
738 $opt, " (number expected)\n");
742 unshift (@ARGV, $starter.$rest) if defined $rest;
746 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
747 # Supply default value.
753 elsif ( $type eq "f" ) { # real number, int is also ok
754 # We require at least one digit before a point or 'e',
755 # and at least one digit following the point and 'e'.
757 if ( $bundling && defined $rest &&
758 $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
761 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
763 elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
764 if ( defined $optarg || $mand eq "=" ) {
765 if ( $passthrough ) {
766 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
767 unless defined $optarg;
770 warn ("Value \"", $arg, "\" invalid for option ",
771 $opt, " (real number expected)\n");
775 unshift (@ARGV, $starter.$rest) if defined $rest;
779 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
780 # Supply default value.
786 Croak ("GetOpt::Long internal error (Can't happen)\n");
788 return (1, $opt, $arg, $dsttype, $incr, $key);
791 # Getopt::Long Configuration.
796 [ $error, $debug, $major_version, $minor_version,
797 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
798 $passthrough, $genprefix ];
800 if ( ref($options[0]) eq 'ARRAY' ) {
801 ( $error, $debug, $major_version, $minor_version,
802 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
803 $passthrough, $genprefix ) = @{shift(@options)};
807 foreach $opt ( @options ) {
810 if ( $try =~ /^no_?(.*)$/s ) {
814 if ( $try eq 'default' or $try eq 'defaults' ) {
815 ConfigDefaults () if $action;
817 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
818 $autoabbrev = $action;
820 elsif ( $try eq 'getopt_compat' ) {
821 $getopt_compat = $action;
823 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
824 $ignorecase = $action;
826 elsif ( $try eq 'ignore_case_always' ) {
827 $ignorecase = $action ? 2 : 0;
829 elsif ( $try eq 'bundling' ) {
832 elsif ( $try eq 'bundling_override' ) {
833 $bundling = $action ? 2 : 0;
835 elsif ( $try eq 'require_order' ) {
836 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
838 elsif ( $try eq 'permute' ) {
839 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
841 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
842 $passthrough = $action;
844 elsif ( $try =~ /^prefix=(.+)$/ ) {
846 # Turn into regexp. Needs to be parenthesized!
847 $genprefix = "(" . quotemeta($genprefix) . ")";
848 eval { '' =~ /$genprefix/; };
849 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
851 elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
853 # Parenthesize if needed.
854 $genprefix = "(" . $genprefix . ")"
855 unless $genprefix =~ /^\(.*\)$/;
856 eval { '' =~ /$genprefix/; };
857 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
859 elsif ( $try eq 'debug' ) {
863 Croak ("Getopt::Long: unknown config parameter \"$opt\"")
874 # To prevent Carp from being loaded unnecessarily.
877 $Carp::CarpLevel = 1;
881 ################ Documentation ################
885 Getopt::Long - Extended processing of command line options
890 $result = GetOptions (...option-descriptions...);
894 The Getopt::Long module implements an extended getopt function called
895 GetOptions(). This function adheres to the POSIX syntax for command
896 line options, with GNU extensions. In general, this means that options
897 have long names instead of single letters, and are introduced with a
898 double dash "--". Support for bundling of command line options, as was
899 the case with the more traditional single-letter approach, is provided
900 but not enabled by default.
902 =head1 Command Line Options, an Introduction
904 Command line operated programs traditionally take their arguments from
905 the command line, for example filenames or other information that the
906 program needs to know. Besides arguments, these programs often take
907 command line I<options> as well. Options are not necessary for the
908 program to work, hence the name 'option', but are used to modify its
909 default behaviour. For example, a program could do its job quietly,
910 but with a suitable option it could provide verbose information about
913 Command line options come in several flavours. Historically, they are
914 preceded by a single dash C<->, and consist of a single letter.
918 Usually, these single-character options can be bundled:
922 Options can have values, the value is placed after the option
923 character. Sometimes with whitespace in between, sometimes not:
927 Due to the very cryptic nature of these options, another style was
928 developed that used long names. So instead of a cryptic C<-l> one
929 could use the more descriptive C<--long>. To distinguish between a
930 bundle of single-character options and a long one, two dashes are used
931 to precede the option name. Early implementations of long options used
932 a plus C<+> instead. Also, option values could be specified either
941 The C<+> form is now obsolete and strongly deprecated.
943 =head1 Getting Started with Getopt::Long
945 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
946 the firs Perl module that provided support for handling the new style
947 of command line options, hence the name Getopt::Long. This module
948 also supports single-character options and bundling. In this case, the
949 options are restricted to alphabetic characters only, and the
950 characters C<?> and C<->.
952 To use Getopt::Long from a Perl program, you must include the
953 following line in your Perl program:
957 This will load the core of the Getopt::Long module and prepare your
958 program for using it. Most of the actual Getopt::Long code is not
959 loaded until you really call one of its functions.
961 In the default configuration, options names may be abbreviated to
962 uniqueness, case does not matter, and a single dash is sufficient,
963 even for long option names. Also, options may be placed between
964 non-option arguments. See L<Configuring Getopt::Long> for more
965 details on how to configure Getopt::Long.
967 =head2 Simple options
969 The most simple options are the ones that take no values. Their mere
970 presence on the command line enables the option. Popular examples are:
972 --all --verbose --quiet --debug
974 Handling simple options is straightforward:
976 my $verbose = ''; # option variable with default value (false)
977 my $all = ''; # option variable with default value (false)
978 GetOptions ('verbose' => \$verbose, 'all' => \$all);
980 The call to GetOptions() parses the command line arguments that are
981 present in C<@ARGV> and sets the option variable to the value C<1> if
982 the option did occur on the command line. Otherwise, the option
983 variable is not touched. Setting the option value to true is often
984 called I<enabling> the option.
986 The option name as specified to the GetOptions() function is called
987 the option I<specification>. Later we'll see that this specification
988 can contain more than just the option name. The reference to the
989 variable is called the option I<destination>.
991 GetOptions() will return a true value if the command line could be
992 processed successfully. Otherwise, it will write error messages to
993 STDERR, and return a false result.
995 =head2 A little bit less simple options
997 Getopt::Long supports two useful variants of simple options:
998 I<negatable> options and I<incremental> options.
1000 A negatable option is specified with a exclamation mark C<!> after the
1003 my $verbose = ''; # option variable with default value (false)
1004 GetOptions ('verbose!' => \$verbose);
1006 Now, using C<--verbose> on the command line will enable C<$verbose>,
1007 as expected. But it is also allowed to use C<--noverbose>, which will
1008 disable C<$verbose> by setting its value to C<0>. Using a suitable
1009 default value, the program can find out whether C<$verbose> is false
1010 by default, or disabled by using C<--noverbose>.
1012 An incremental option is specified with a plus C<+> after the
1015 my $verbose = ''; # option variable with default value (false)
1016 GetOptions ('verbose+' => \$verbose);
1018 Using C<--verbose> on the command line will increment the value of
1019 C<$verbose>. This way the program can keep track of how many times the
1020 option occurred on the command line. For example, each occurrence of
1021 C<--verbose> could increase the verbosity level of the program.
1023 =head2 Mixing command line option with other arguments
1025 Usually programs take command line options as well as other arguments,
1026 for example, file names. It is good practice to always specify the
1027 options first, and the other arguments last. Getopt::Long will,
1028 however, allow the options and arguments to be mixed and 'filter out'
1029 all the options before passing the rest of the arguments to the
1030 program. To stop Getopt::Long from processing further arguments,
1031 insert a double dash C<--> on the command line:
1035 In this example, C<--all> will I<not> be treated as an option, but
1036 passed to the program unharmed, in C<@ARGV>.
1038 =head2 Options with values
1040 For options that take values it must be specified whether the option
1041 value is required or not, and what kind of value the option expects.
1043 Three kinds of values are supported: integer numbers, floating point
1044 numbers, and strings.
1046 If the option value is required, Getopt::Long will take the
1047 command line argument that follows the option and assign this to the
1048 option variable. If, however, the option value is specified as
1049 optional, this will only be done if that value does not look like a
1050 valid command line option itself.
1052 my $tag = ''; # option variable with default value
1053 GetOptions ('tag=s' => \$tag);
1055 In the option specification, the option name is followed by an equals
1056 sign C<=> and the letter C<s>. The equals sign indicates that this
1057 option requires a value. The letter C<s> indicates that this value is
1058 an arbitrary string. Other possible value types are C<i> for integer
1059 values, and C<f> for floating point values. Using a colon C<:> instead
1060 of the equals sign indicates that the option value is optional. In
1061 this case, if no suitable value is supplied, string valued options get
1062 an empty string C<''> assigned, while numeric options are set to C<0>.
1064 =head2 Options with multiple values
1066 Options sometimes take several values. For example, a program could
1067 use multiple directories to search for library files:
1069 --library lib/stdlib --library lib/extlib
1071 To accomplish this behaviour, simply specify an array reference as the
1072 destination for the option:
1075 GetOptions ("library=s" => \@libfiles);
1077 Used with the example above, C<@libfiles> would contain two strings
1078 upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
1079 It is also possible to specify that only integer or floating point
1080 numbers are acceptible values.
1082 Often it is useful to allow comma-separated lists of values as well as
1083 multiple occurrences of the options. This is easy using Perl's split()
1084 and join() operators:
1087 GetOptions ("library=s" => \@libfiles);
1088 @libfiles = split(/,/,join(',',@libfiles));
1090 Of course, it is important to choose the right separator string for
1093 =head2 Options with hash values
1095 If the option destination is a reference to a hash, the option will
1096 take, as value, strings of the form I<key>C<=>I<value>. The value will
1097 be stored with the specified key in the hash.
1100 GetOptions ("define=s" => \%defines);
1102 When used with command line options:
1104 --define os=linux --define vendor=redhat
1106 the hash C<%defines> will contain two keys, C<"os"> with value
1107 C<"linux> and C<"vendor"> with value C<"redhat">.
1108 It is also possible to specify that only integer or floating point
1109 numbers are acceptible values. The keys are always taken to be strings.
1111 =head2 User-defined subroutines to handle options
1113 Ultimate control over what should be done when (actually: each time)
1114 an option is encountered on the command line can be achieved by
1115 designating a reference to a subroutine (or an anonymous subroutine)
1116 as the option destination. When GetOptions() encounters the option, it
1117 will call the subroutine with two arguments: the name of the option,
1118 and the value to be assigned. It is up to the subroutine to store the
1119 value, or do whatever it thinks is appropriate.
1121 A trivial application of this mechanism is to implement options that
1122 are related to each other. For example:
1124 my $verbose = ''; # option variable with default value (false)
1125 GetOptions ('verbose' => \$verbose,
1126 'quiet' => sub { $verbose = 0 });
1128 Here C<--verbose> and C<--quiet> control the same variable
1129 C<$verbose>, but with opposite values.
1131 If the subroutine needs to signal an error, it should call die() with
1132 the desired error message as its argument. GetOptions() will catch the
1133 die(), issue the error message, and record that an error result must
1134 be returned upon completion.
1136 If the text of the error message starts with an exclamantion mark C<!>
1137 it is interpreted specially by GetOptions(). There is currently one
1138 special command implemented: C<die("!FINISH")> will cause GetOptions()
1139 to stop processing options, as if it encountered a double dash C<-->.
1141 =head2 Options with multiple names
1143 Often it is user friendly to supply alternate mnemonic names for
1144 options. For example C<--height> could be an alternate name for
1145 C<--length>. Alternate names can be included in the option
1146 specification, separated by vertical bar C<|> characters. To implement
1149 GetOptions ('length|height=f' => \$length);
1151 The first name is called the I<primary> name, the other names are
1154 Multiple alternate names are possible.
1156 =head2 Case and abbreviations
1158 Without additional configuration, GetOptions() will ignore the case of
1159 option names, and allow the options to be abbreviated to uniqueness.
1161 GetOptions ('length|height=f' => \$length, "head" => \$head);
1163 This call will allow C<--l> and C<--L> for the length option, but
1164 requires a least C<--hea> and C<--hei> for the head and height options.
1166 =head2 Summary of Option Specifications
1168 Each option specifier consists of two parts: the name specification
1169 and the argument specification.
1171 The name specification contains the name of the option, optionally
1172 followed by a list of alternative names separated by vertical bar
1175 length option name is "length"
1176 length|size|l name is "length", aliases are "size" and "l"
1178 The argument specification is optional. If omitted, the option is
1179 considered boolean, a value of 1 will be assigned when the option is
1180 used on the command line.
1182 The argument specification can be
1188 The option does not take an argument and may be negated, i.e. prefixed
1189 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
1190 assigned) and C<--nofoo> (a value of 0 will be assigned). If the
1191 option has aliases, this applies to the aliases as well.
1193 Using negation on a single letter option when bundling is in effect is
1194 pointless and will result in a warning.
1198 The option does not take an argument and will be incremented by 1
1199 every time it appears on the command line. E.g. C<"more+">, when used
1200 with C<--more --more --more>, will increment the value three times,
1201 resulting in a value of 3 (provided it was 0 or undefined at first).
1203 The C<+> specifier is ignored if the option destination is not a scalar.
1205 =item = I<type> [ I<desttype> ]
1207 The option requires an argument of the given type. Supported types
1214 String. An arbitrary sequence of characters. It is valid for the
1215 argument to start with C<-> or C<-->.
1219 Integer. An optional leading plus or minus sign, followed by a
1224 Real number. For example C<3.14>, C<-6.23E24> and so on.
1228 The I<desttype> can be C<@> or C<%> to specify that the option is
1229 list or a hash valued. This is only needed when the destination for
1230 the option value is not otherwise specified. It should be omitted when
1233 =item : I<type> [ I<desttype> ]
1235 Like C<=>, but designates the argument as optional.
1236 If omitted, an empty string will be assigned to string values options,
1237 and the value zero to numeric options.
1239 Note that if a string argument starts with C<-> or C<-->, it will be
1240 considered an option on itself.
1244 =head1 Advanced Possibilities
1246 =head2 Documentation and help texts
1248 Getopt::Long encourages the use of Pod::Usage to produce help
1249 messages. For example:
1257 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1258 pod2usage(1) if $help;
1259 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
1265 sample - Using GetOpt::Long and Pod::Usage
1269 sample [options] [file ...]
1272 -help brief help message
1273 -man full documentation
1281 Print a brief help message and exits.
1285 Prints the manual page and exits.
1291 B<This program> will read the given input file(s) and do someting
1292 useful with the contents thereof.
1296 See L<Pod::Usage> for details.
1298 =head2 Storing options in a hash
1300 Sometimes, for example when there are a lot of options, having a
1301 separate variable for each of them can be cumbersome. GetOptions()
1302 supports, as an alternative mechanism, storing options in a hash.
1304 To obtain this, a reference to a hash must be passed I<as the first
1305 argument> to GetOptions(). For each option that is specified on the
1306 command line, the option value will be stored in the hash with the
1307 option name as key. Options that are not actually used on the command
1308 line will not be put in the hash, on other words,
1309 C<exists($h{option})> (or defined()) can be used to test if an option
1310 was used. The drawback is that warnings will be issued if the program
1311 runs under C<use strict> and uses C<$h{option}> without testing with
1312 exists() or defined() first.
1315 GetOptions (\%h, 'length=i'); # will store in $h{length}
1317 For options that take list or hash values, it is necessary to indicate
1318 this by appending an C<@> or C<%> sign after the type:
1320 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
1322 To make things more complicated, the hash may contain references to
1323 the actual destinations, for example:
1326 my %h = ('length' => \$len);
1327 GetOptions (\%h, 'length=i'); # will store in $len
1329 This example is fully equivalent with:
1332 GetOptions ('length=i' => \$len); # will store in $len
1334 Any mixture is possible. For example, the most frequently used options
1335 could be stored in variables while all other options get stored in the
1338 my $verbose = 0; # frequently referred
1339 my $debug = 0; # frequently referred
1340 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1341 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1342 if ( $verbose ) { ... }
1343 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
1347 With bundling it is possible to set several single-character options
1348 at once. For example if C<a>, C<v> and C<x> are all valid options,
1352 would set all three.
1354 Getopt::Long supports two levels of bundling. To enable bundling, a
1355 call to Getopt::Long::Configure is required.
1357 The first level of bundling can be enabled with:
1359 Getopt::Long::Configure ("bundling");
1361 Configured this way, single-character options can be bundled but long
1362 options B<must> always start with a double dash C<--> to avoid
1363 abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1368 would set C<a>, C<v> and C<x>, but
1374 The second level of bundling lifts this restriction. It can be enabled
1377 Getopt::Long::Configure ("bundling_override");
1379 Now, C<-vax> would set the option C<vax>.
1381 When any level of bundling is enabled, option values may be inserted
1382 in the bundle. For example:
1390 When configured for bundling, single-character options are matched
1391 case sensitive while long options are matched case insensitive. To
1392 have the single-character options matched case insensitive as well,
1395 Getopt::Long::Configure ("bundling", "ignorecase_always");
1397 It goes without saying that bundling can be quite confusing.
1399 =head2 The lonesome dash
1401 Some applications require the option C<-> (that's a lone dash). This
1402 can be achieved by adding an option specification with an empty name:
1404 GetOptions ('' => \$stdio);
1406 A lone dash on the command line will now be legal, and set options
1409 =head2 Argument call-back
1411 A special option 'name' C<<>> can be used to designate a subroutine
1412 to handle non-option arguments. When GetOptions() encounters an
1413 argument that does not look like an option, it will immediately call this
1414 subroutine and passes it the argument as a parameter.
1420 GetOptions ('width=i' => \$width, '<>' => \&process);
1422 When applied to the following command line:
1424 arg1 --width=72 arg2 --width=60 arg3
1427 C<process("arg1")> while C<$width> is C<80>,
1428 C<process("arg2")> while C<$width> is C<72>, and
1429 C<process("arg3")> while C<$width> is C<60>.
1431 This feature requires configuration option B<permute>, see section
1432 L<Configuring Getopt::Long>.
1435 =head1 Configuring Getopt::Long
1437 Getopt::Long can be configured by calling subroutine
1438 Getopt::Long::Configure(). This subroutine takes a list of quoted
1439 strings, each specifying a configuration option to be set, e.g.
1440 C<ignore_case>, or reset, e.g. C<no_ignore_case>. Case does not
1441 matter. Multiple calls to Configure() are possible.
1443 The following options are available:
1449 This option causes all configuration options to be reset to their
1454 Allow option names to be abbreviated to uniqueness.
1455 Default is set unless environment variable
1456 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is reset.
1460 Allow C<+> to start options.
1461 Default is set unless environment variable
1462 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is reset.
1466 Whether command line arguments are allowed to be mixed with options.
1467 Default is set unless environment variable
1468 POSIXLY_CORRECT has been set, in which case C<require_order> is reset.
1470 See also C<permute>, which is the opposite of C<require_order>.
1474 Whether command line arguments are allowed to be mixed with options.
1475 Default is set unless environment variable
1476 POSIXLY_CORRECT has been set, in which case C<permute> is reset.
1477 Note that C<permute> is the opposite of C<require_order>.
1479 If C<permute> is set, this means that
1481 --foo arg1 --bar arg2 arg3
1485 --foo --bar arg1 arg2 arg3
1487 If an argument call-back routine is specified, C<@ARGV> will always be
1488 empty upon succesful return of GetOptions() since all options have been
1489 processed. The only exception is when C<--> is used:
1491 --foo arg1 --bar arg2 -- arg3
1493 will call the call-back routine for arg1 and arg2, and terminate
1494 GetOptions() leaving C<"arg2"> in C<@ARGV>.
1496 If C<require_order> is set, options processing
1497 terminates when the first non-option is encountered.
1499 --foo arg1 --bar arg2 arg3
1503 --foo -- arg1 --bar arg2 arg3
1505 =item bundling (default: reset)
1507 Setting this option will allow single-character options to be bundled.
1508 To distinguish bundles from long option names, long options I<must> be
1509 introduced with C<--> and single-character options (and bundles) with
1512 Note: resetting C<bundling> also resets C<bundling_override>.
1514 =item bundling_override (default: reset)
1516 If C<bundling_override> is set, bundling is enabled as with
1517 C<bundling> but now long option names override option bundles.
1519 Note: resetting C<bundling_override> also resets C<bundling>.
1521 B<Note:> Using option bundling can easily lead to unexpected results,
1522 especially when mixing long options and bundles. Caveat emptor.
1524 =item ignore_case (default: set)
1526 If set, case is ignored when matching long option names. Single
1527 character options will be treated case-sensitive.
1529 Note: resetting C<ignore_case> also resets C<ignore_case_always>.
1531 =item ignore_case_always (default: reset)
1533 When bundling is in effect, case is ignored on single-character
1536 Note: resetting C<ignore_case_always> also resets C<ignore_case>.
1538 =item pass_through (default: reset)
1540 Options that are unknown, ambiguous or supplied with an invalid option
1541 value are passed through in C<@ARGV> instead of being flagged as
1542 errors. This makes it possible to write wrapper scripts that process
1543 only part of the user supplied command line arguments, and pass the
1544 remaining options to some other program.
1546 This can be very confusing, especially when C<permute> is also set.
1550 The string that starts options. If a constant string is not
1551 sufficient, see C<prefix_pattern>.
1553 =item prefix_pattern
1555 A Perl pattern that identifies the strings that introduce options.
1556 Default is C<(--|-|\+)> unless environment variable
1557 POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1559 =item debug (default: reset)
1561 Enable copious debugging output.
1565 =head1 Return values and Errors
1567 Configuration errors and errors in the option definitions are
1568 signalled using die() and will terminate the calling program unless
1569 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
1570 }>, or die() was trapped using C<$SIG{__DIE__}>.
1572 A return value of 1 (true) indicates success.
1574 A return status of 0 (false) indicates that the function detected one
1575 or more errors during option parsing. These errors are signalled using
1576 warn() and can be trapped with C<$SIG{__WARN__}>.
1578 Errors that can't happen are signalled using Carp::croak().
1582 The earliest development of C<newgetopt.pl> started in 1990, with Perl
1583 version 4. As a result, its development, and the development of
1584 Getopt::Long, has gone through several stages. Since backward
1585 compatibility has always been extremely important, the current version
1586 of Getopt::Long still supports a lot of constructs that nowadays are
1587 no longer necessary or otherwise unwanted. This section describes
1588 briefly some of these 'features'.
1590 =head2 Default destinations
1592 When no destination is specified for an option, GetOptions will store
1593 the resultant value in a global variable named C<opt_>I<XXX>, where
1594 I<XXX> is the primary name of this option. When a progam executes
1595 under C<use strict> (recommended), these variables must be
1596 pre-declared with our() or C<use vars>.
1598 our $opt_length = 0;
1599 GetOptions ('length=i'); # will store in $opt_length
1601 To yield a usable Perl variable, characters that are not part of the
1602 syntax for variables are translated to underscores. For example,
1603 C<--fpp-struct-return> will set the variable
1604 C<$opt_fpp_struct_return>. Note that this variable resides in the
1605 namespace of the calling program, not necessarily C<main>. For
1608 GetOptions ("size=i", "sizes=i@");
1610 with command line "-size 10 -sizes 24 -sizes 48" will perform the
1611 equivalent of the assignments
1614 @opt_sizes = (24, 48);
1616 =head2 Alternative option starters
1618 A string of alternative option starter characters may be passed as the
1619 first argument (or the first argument after a leading hash reference
1623 GetOptions ('/', 'length=i' => $len);
1625 Now the command line may look like:
1629 Note that to terminate options processing still requires a double dash
1632 GetOptions() will not interpret a leading C<"<>"> as option starters
1633 if the next argument is a reference. To force C<"<"> and C<">"> as
1634 option starters, use C<"><">. Confusing? Well, B<using a starter
1635 argument is strongly deprecated> anyway.
1637 =head2 Configuration variables
1639 Previous versions of Getopt::Long used variables for the purpose of
1640 configuring. Although manipulating these variables still work, it
1641 is strongly encouraged to use the new C<config> routine. Besides, it
1646 Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
1648 =head1 COPYRIGHT AND DISCLAIMER
1650 This program is Copyright 2000,1990 by Johan Vromans.
1651 This program is free software; you can redistribute it and/or
1652 modify it under the terms of the Perl Artistic License or the
1653 GNU General Public License as published by the Free Software
1654 Foundation; either version 2 of the License, or (at your option) any
1657 This program is distributed in the hope that it will be useful,
1658 but WITHOUT ANY WARRANTY; without even the implied warranty of
1659 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1660 GNU General Public License for more details.
1662 If you do not have a copy of the GNU General Public License write to
1663 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
1670 # eval: (load-file "pod.el")