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 ################ Package return ################
109 ################ AutoLoading subroutines ################
111 # RCS Status : $Id: GetoptLongAl.pl,v 2.25 2000-03-05 21:08:03+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: Sat Mar 4 16:33:02 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.25 $ ',
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");
234 $opctl{$_} = $bopctl{$_} = $c;
237 $_ = lc ($_) if $ignorecase;
256 # If no linkage is supplied in the @optionlist, copy it from
257 # the userlinkage if available.
258 if ( defined $userlinkage ) {
259 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
260 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
261 print STDERR ("=> found userlinkage for \"$o\": ",
262 "$userlinkage->{$o}\n")
264 unshift (@optionlist, $userlinkage->{$o});
267 # Do nothing. Being undefined will be handled later.
273 # Copy the linkage. If omitted, link to global variable.
274 if ( @optionlist > 0 && ref($optionlist[0]) ) {
275 print STDERR ("=> link \"$o\" to $optionlist[0]\n")
277 if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
278 $linkage{$o} = shift (@optionlist);
280 elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
281 $linkage{$o} = shift (@optionlist);
283 if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
285 if $bundling and defined $bopctl{$o} and
286 $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
288 elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
289 $linkage{$o} = shift (@optionlist);
291 if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
293 if $bundling and defined $bopctl{$o} and
294 $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
297 $error .= "Invalid option linkage for \"$opt\"\n";
301 # Link to global $opt_XXX variable.
302 # Make sure a valid perl identifier results.
306 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
308 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
310 elsif ( $c =~ /%/ ) {
311 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
313 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
316 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
318 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
323 # Bail out if errors found.
324 die ($error) if $error;
327 # Sort the possible long option names.
328 @opctl = sort(keys (%opctl)) if $autoabbrev;
330 # Show the options tables if debugging.
334 while ( ($k,$v) = each(%opctl) ) {
335 print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
339 while ( ($k,$v) = each(%bopctl) ) {
340 print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
345 # Process argument list
347 while ( $goon && @ARGV > 0 ) {
349 #### Get next argument ####
351 $opt = shift (@ARGV);
352 print STDERR ("=> option \"", $opt, "\"\n") if $debug;
354 #### Determine what we have ####
356 # Double dash is option list terminator.
357 if ( $opt eq $argend ) {
358 # Finish. Push back accumulated arguments and return.
359 unshift (@ARGV, @ret)
360 if $order == $PERMUTE;
361 return ($error == 0);
365 my $found; # success status
366 my $dsttype; # destination type ('@' or '%')
367 my $incr; # destination increment
368 my $key; # key (if hash type)
369 my $arg; # option argument
371 ($found, $opt, $arg, $dsttype, $incr, $key) =
372 FindOption ($genprefix, $argend, $opt,
373 \%opctl, \%bopctl, \@opctl, \%aliases);
377 # FindOption undefines $opt in case of errors.
378 next unless defined $opt;
380 if ( defined $arg ) {
381 $opt = $aliases{$opt} if defined $aliases{$opt};
383 if ( defined $linkage{$opt} ) {
384 print STDERR ("=> ref(\$L{$opt}) -> ",
385 ref($linkage{$opt}), "\n") if $debug;
387 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
389 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
391 if ( defined ${$linkage{$opt}} ) {
392 ${$linkage{$opt}} += $arg;
395 ${$linkage{$opt}} = $arg;
399 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
401 ${$linkage{$opt}} = $arg;
404 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
405 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
407 push (@{$linkage{$opt}}, $arg);
409 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
410 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
412 $linkage{$opt}->{$key} = $arg;
414 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
415 print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
419 &{$linkage{$opt}}($opt, $arg);
421 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
422 if ( $@ =~ /^FINISH\b/ ) {
431 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
433 Croak ("Getopt::Long -- internal error!\n");
436 # No entry in linkage means entry in userlinkage.
437 elsif ( $dsttype eq '@' ) {
438 if ( defined $userlinkage->{$opt} ) {
439 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
441 push (@{$userlinkage->{$opt}}, $arg);
444 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
446 $userlinkage->{$opt} = [$arg];
449 elsif ( $dsttype eq '%' ) {
450 if ( defined $userlinkage->{$opt} ) {
451 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
453 $userlinkage->{$opt}->{$key} = $arg;
456 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
458 $userlinkage->{$opt} = {$key => $arg};
463 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
465 if ( defined $userlinkage->{$opt} ) {
466 $userlinkage->{$opt} += $arg;
469 $userlinkage->{$opt} = $arg;
473 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
474 $userlinkage->{$opt} = $arg;
480 # Not an option. Save it if we $PERMUTE and don't have a <>.
481 elsif ( $order == $PERMUTE ) {
482 # Try non-options call-back.
484 if ( (defined ($cb = $linkage{'<>'})) ) {
489 print STDERR ("=> die($@)\n") if $debug && $@ ne '';
490 if ( $@ =~ /^FINISH\b/ ) {
499 print STDERR ("=> saving \"$tryopt\" ",
500 "(not an option, may permute)\n") if $debug;
501 push (@ret, $tryopt);
506 # ...otherwise, terminate.
508 # Push this one back and exit.
509 unshift (@ARGV, $tryopt);
510 return ($error == 0);
516 if ( $order == $PERMUTE ) {
517 # Push back accumulated arguments
518 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
519 if $debug && @ret > 0;
520 unshift (@ARGV, @ret) if @ret > 0;
523 return ($error == 0);
527 sub FindOption ($$$$$$$) {
529 # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
530 # returns (0) otherwise.
532 my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
533 my $key; # hash key for a hash option
536 print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
538 return (0) unless $opt =~ /^$prefix(.*)$/s;
543 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
545 my $optarg = undef; # value supplied with --opt=value
546 my $rest = undef; # remainder from unbundling
548 # If it is a long option, it may include the value.
549 if (($starter eq "--" || ($getopt_compat && !$bundling))
550 && $opt =~ /^([^=]+)=(.*)$/s ) {
553 print STDERR ("=> option \"", $opt,
554 "\", optarg = \"$optarg\"\n") if $debug;
559 my $tryopt = $opt; # option to try
560 my $optbl = $opctl; # table to look it up (long names)
565 if ( $bundling && $starter eq '-' ) {
566 # Unbundle single letter option.
567 $rest = substr ($tryopt, 1);
568 $tryopt = substr ($tryopt, 0, 1);
569 $tryopt = lc ($tryopt) if $ignorecase > 1;
570 print STDERR ("=> $starter$tryopt unbundled from ",
571 "$starter$tryopt$rest\n") if $debug;
572 $rest = undef unless $rest ne '';
573 $optbl = $bopctl; # look it up in the short names table
575 # If bundling == 2, long options can override bundles.
576 if ( $bundling == 2 and
578 defined ($type = $opctl->{$tryopt.$rest}) ) {
579 print STDERR ("=> $starter$tryopt rebundled to ",
580 "$starter$tryopt$rest\n") if $debug;
586 # Try auto-abbreviation.
587 elsif ( $autoabbrev ) {
588 # Downcase if allowed.
589 $tryopt = $opt = lc ($opt) if $ignorecase;
590 # Turn option name into pattern.
591 my $pat = quotemeta ($opt);
592 # Look up in option names.
593 my @hits = grep (/^$pat/, @{$names});
594 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
595 "out of ", scalar(@{$names}), "\n") if $debug;
597 # Check for ambiguous results.
598 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
599 # See if all matches are for the same option.
602 $_ = $aliases->{$_} if defined $aliases->{$_};
605 # Now see if it really is ambiguous.
606 unless ( keys(%hit) == 1 ) {
607 return (0) if $passthrough;
608 warn ("Option ", $opt, " is ambiguous (",
609 join(", ", @hits), ")\n");
612 return (1, $opt,$arg,$dsttype,$incr,$key);
617 # Complete the option name, if appropriate.
618 if ( @hits == 1 && $hits[0] ne $opt ) {
620 $tryopt = lc ($tryopt) if $ignorecase;
621 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
626 # Map to all lowercase if ignoring case.
627 elsif ( $ignorecase ) {
631 # Check validity by fetching the info.
632 $type = $optbl->{$tryopt} unless defined $type;
633 unless ( defined $type ) {
634 return (0) if $passthrough;
635 warn ("Unknown option: ", $opt, "\n");
637 return (1, $opt,$arg,$dsttype,$incr,$key);
641 print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
643 #### Determine argument status ####
645 # If it is an option w/o argument, we're almost finished with it.
646 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
647 if ( defined $optarg ) {
648 return (0) if $passthrough;
649 warn ("Option ", $opt, " does not take an argument\n");
653 elsif ( $type eq '' || $type eq '+' ) {
654 $arg = 1; # supply explicit value
655 $incr = $type eq '+';
658 substr ($opt, 0, 2) = ''; # strip NO prefix
659 $arg = 0; # supply explicit value
661 unshift (@ARGV, $starter.$rest) if defined $rest;
662 return (1, $opt,$arg,$dsttype,$incr,$key);
665 # Get mandatory status and type info.
667 ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
669 # Check if there is an option argument available.
670 if ( defined $optarg ? ($optarg eq '')
671 : !(defined $rest || @ARGV > 0) ) {
672 # Complain if this option needs an argument.
673 if ( $mand eq "=" ) {
674 return (0) if $passthrough;
675 warn ("Option ", $opt, " requires an argument\n");
679 if ( $mand eq ":" ) {
680 $arg = $type eq "s" ? '' : 0;
682 return (1, $opt,$arg,$dsttype,$incr,$key);
685 # Get (possibly optional) argument.
686 $arg = (defined $rest ? $rest
687 : (defined $optarg ? $optarg : shift (@ARGV)));
689 # Get key if this is a "name=value" pair for a hash option.
691 if ($dsttype eq '%' && defined $arg) {
692 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
695 #### Check if the argument is valid for this option ####
697 if ( $type eq "s" ) { # string
698 # A mandatory string takes anything.
699 return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
701 # An optional string takes almost anything.
702 return (1, $opt,$arg,$dsttype,$incr,$key)
703 if defined $optarg || defined $rest;
704 return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
706 # Check for option or option list terminator.
707 if ($arg eq $argend ||
708 $arg =~ /^$prefix.+/) {
710 unshift (@ARGV, $arg);
711 # Supply empty value.
716 elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
717 if ( $bundling && defined $rest && $rest =~ /^([-+]?[0-9]+)(.*)$/s ) {
720 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
722 elsif ( $arg !~ /^[-+]?[0-9]+$/ ) {
723 if ( defined $optarg || $mand eq "=" ) {
724 if ( $passthrough ) {
725 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
726 unless defined $optarg;
729 warn ("Value \"", $arg, "\" invalid for option ",
730 $opt, " (number expected)\n");
734 unshift (@ARGV, $starter.$rest) if defined $rest;
738 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
739 # Supply default value.
745 elsif ( $type eq "f" ) { # real number, int is also ok
746 # We require at least one digit before a point or 'e',
747 # and at least one digit following the point and 'e'.
749 if ( $bundling && defined $rest &&
750 $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
753 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
755 elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
756 if ( defined $optarg || $mand eq "=" ) {
757 if ( $passthrough ) {
758 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
759 unless defined $optarg;
762 warn ("Value \"", $arg, "\" invalid for option ",
763 $opt, " (real number expected)\n");
767 unshift (@ARGV, $starter.$rest) if defined $rest;
771 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
772 # Supply default value.
778 Croak ("GetOpt::Long internal error (Can't happen)\n");
780 return (1, $opt, $arg, $dsttype, $incr, $key);
783 # Getopt::Long Configuration.
788 [ $error, $debug, $major_version, $minor_version,
789 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
790 $passthrough, $genprefix ];
792 if ( ref($options[0]) eq 'ARRAY' ) {
793 ( $error, $debug, $major_version, $minor_version,
794 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
795 $passthrough, $genprefix ) = @{shift(@options)};
799 foreach $opt ( @options ) {
802 if ( $try =~ /^no_?(.*)$/s ) {
806 if ( $try eq 'default' or $try eq 'defaults' ) {
807 ConfigDefaults () if $action;
809 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
810 $autoabbrev = $action;
812 elsif ( $try eq 'getopt_compat' ) {
813 $getopt_compat = $action;
815 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
816 $ignorecase = $action;
818 elsif ( $try eq 'ignore_case_always' ) {
819 $ignorecase = $action ? 2 : 0;
821 elsif ( $try eq 'bundling' ) {
824 elsif ( $try eq 'bundling_override' ) {
825 $bundling = $action ? 2 : 0;
827 elsif ( $try eq 'require_order' ) {
828 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
830 elsif ( $try eq 'permute' ) {
831 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
833 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
834 $passthrough = $action;
836 elsif ( $try =~ /^prefix=(.+)$/ ) {
838 # Turn into regexp. Needs to be parenthesized!
839 $genprefix = "(" . quotemeta($genprefix) . ")";
840 eval { '' =~ /$genprefix/; };
841 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
843 elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
845 # Parenthesize if needed.
846 $genprefix = "(" . $genprefix . ")"
847 unless $genprefix =~ /^\(.*\)$/;
848 eval { '' =~ /$genprefix/; };
849 Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
851 elsif ( $try eq 'debug' ) {
855 Croak ("Getopt::Long: unknown config parameter \"$opt\"")
866 # To prevent Carp from being loaded unnecessarily.
869 $Carp::CarpLevel = 1;
873 ################ Documentation ################
877 Getopt::Long - Extended processing of command line options
882 $result = GetOptions (...option-descriptions...);
886 The Getopt::Long module implements an extended getopt function called
887 GetOptions(). This function adheres to the POSIX syntax for command
888 line options, with GNU extensions. In general, this means that options
889 have long names instead of single letters, and are introduced with a
890 double dash "--". Support for bundling of command line options, as was
891 the case with the more traditional single-letter approach, is provided
892 but not enabled by default.
894 =head1 Command Line Options, an Introduction
896 Command line operated programs traditionally take their arguments from
897 the command line, for example filenames or other information that the
898 program needs to know. Besides arguments, these programs often take
899 command line I<options> as well. Options are not necessary for the
900 program to work, hence the name 'option', but are used to modify its
901 default behaviour. For example, a program could do its job quietly,
902 but with a suitable option it could provide verbose information about
905 Command line options come in several flavours. Historically, they are
906 preceded by a single dash C<->, and consist of a single letter.
910 Usually, these single-character options can be bundled:
914 Options can have values, the value is placed after the option
915 character. Sometimes with whitespace in between, sometimes not:
919 Due to the very cryptic nature of these options, another style was
920 developed that used long names. So instead of a cryptic C<-l> one
921 could use the more descriptive C<--long>. To distinguish between a
922 bundle of single-character options and a long one, two dashes are used
923 to precede the option name. Early implementations of long options used
924 a plus C<+> instead. Also, option values could be specified either
933 The C<+> form is now obsolete and strongly deprecated.
935 =head1 Getting Started with Getopt::Long
937 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
938 the firs Perl module that provided support for handling the new style
939 of command line options, hence the name Getopt::Long. This module
940 also supports single-character options and bundling. In this case, the
941 options are restricted to alphabetic characters only, and the
942 characters C<?> and C<->.
944 To use Getopt::Long from a Perl program, you must include the
945 following line in your Perl program:
949 This will load the core of the Getopt::Long module and prepare your
950 program for using it. Most of the actual Getopt::Long code is not
951 loaded until you really call one of its functions.
953 In the default configuration, options names may be abbreviated to
954 uniqueness, case does not matter, and a single dash is sufficient,
955 even for long option names. Also, options may be placed between
956 non-option arguments. See L<Configuring Getopt::Long> for more
957 details on how to configure Getopt::Long.
959 =head2 Simple options
961 The most simple options are the ones that take no values. Their mere
962 presence on the command line enables the option. Popular examples are:
964 --all --verbose --quiet --debug
966 Handling simple options is straightforward:
968 my $verbose = ''; # option variable with default value (false)
969 my $all = ''; # option variable with default value (false)
970 GetOptions ('verbose' => \$verbose, 'all' => \$all);
972 The call to GetOptions() parses the command line arguments that are
973 present in C<@ARGV> and sets the option variable to the value C<1> if
974 the option did occur on the command line. Otherwise, the option
975 variable is not touched. Setting the option value to true is often
976 called I<enabling> the option.
978 The option name as specified to the GetOptions() function is called
979 the option I<specification>. Later we'll see that this specification
980 can contain more than just the option name. The reference to the
981 variable is called the option I<destination>.
983 GetOptions() will return a true value if the command line could be
984 processed successfully. Otherwise, it will write error messages to
985 STDERR, and return a false result.
987 =head2 A little bit less simple options
989 Getopt::Long supports two useful variants of simple options:
990 I<negatable> options and I<incremental> options.
992 A negatable option is specified with a exclamation mark C<!> after the
995 my $verbose = ''; # option variable with default value (false)
996 GetOptions ('verbose!' => \$verbose);
998 Now, using C<--verbose> on the command line will enable C<$verbose>,
999 as expected. But it is also allowed to use C<--noverbose>, which will
1000 disable C<$verbose> by setting its value to C<0>. Using a suitable
1001 default value, the program can find out whether C<$verbose> is false
1002 by default, or disabled by using C<--noverbose>.
1004 An incremental option is specified with a plus C<+> after the
1007 my $verbose = ''; # option variable with default value (false)
1008 GetOptions ('verbose+' => \$verbose);
1010 Using C<--verbose> on the command line will increment the value of
1011 C<$verbose>. This way the program can keep track of how many times the
1012 option occurred on the command line. For example, each occurrence of
1013 C<--verbose> could increase the verbosity level of the program.
1015 =head2 Mixing command line option with other arguments
1017 Usually programs take command line options as well as other arguments,
1018 for example, file names. It is good practice to always specify the
1019 options first, and the other arguments last. Getopt::Long will,
1020 however, allow the options and arguments to be mixed and 'filter out'
1021 all the options before passing the rest of the arguments to the
1022 program. To stop Getopt::Long from processing further arguments,
1023 insert a double dash C<--> on the command line:
1027 In this example, C<--all> will I<not> be treated as an option, but
1028 passed to the program unharmed, in C<@ARGV>.
1030 =head2 Options with values
1032 For options that take values it must be specified whether the option
1033 value is required or not, and what kind of value the option expects.
1035 Three kinds of values are supported: integer numbers, floating point
1036 numbers, and strings.
1038 If the option value is required, Getopt::Long will take the
1039 command line argument that follows the option and assign this to the
1040 option variable. If, however, the option value is specified as
1041 optional, this will only be done if that value does not look like a
1042 valid command line option itself.
1044 my $tag = ''; # option variable with default value
1045 GetOptions ('tag=s' => \$tag);
1047 In the option specification, the option name is followed by an equals
1048 sign C<=> and the letter C<s>. The equals sign indicates that this
1049 option requires a value. The letter C<s> indicates that this value is
1050 an arbitrary string. Other possible value types are C<i> for integer
1051 values, and C<f> for floating point values. Using a colon C<:> instead
1052 of the equals sign indicates that the option value is optional. In
1053 this case, if no suitable value is supplied, string valued options get
1054 an empty string C<''> assigned, while numeric options are set to C<0>.
1056 =head2 Options with multiple values
1058 Options sometimes take several values. For example, a program could
1059 use multiple directories to search for library files:
1061 --library lib/stdlib --library lib/extlib
1063 To accomplish this behaviour, simply specify an array reference as the
1064 destination for the option:
1067 GetOptions ("library=s" => \@libfiles);
1069 Used with the example above, C<@libfiles> would contain two strings
1070 upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
1071 It is also possible to specify that only integer or floating point
1072 numbers are acceptible values.
1074 Often it is useful to allow comma-separated lists of values as well as
1075 multiple occurrences of the options. This is easy using Perl's split()
1076 and join() operators:
1079 GetOptions ("library=s" => \@libfiles);
1080 @libfiles = split(/,/,join(',',@libfiles));
1082 Of course, it is important to choose the right separator string for
1085 =head2 Options with hash values
1087 If the option destination is a reference to a hash, the option will
1088 take, as value, strings of the form I<key>C<=>I<value>. The value will
1089 be stored with the specified key in the hash.
1092 GetOptions ("define=s" => \%defines);
1094 When used with command line options:
1096 --define os=linux --define vendor=redhat
1098 the hash C<%defines> will contain two keys, C<"os"> with value
1099 C<"linux> and C<"vendor"> with value C<"redhat">.
1100 It is also possible to specify that only integer or floating point
1101 numbers are acceptible values. The keys are always taken to be strings.
1103 =head2 User-defined subroutines to handle options
1105 Ultimate control over what should be done when (actually: each time)
1106 an option is encountered on the command line can be achieved by
1107 designating a reference to a subroutine (or an anonymous subroutine)
1108 as the option destination. When GetOptions() encounters the option, it
1109 will call the subroutine with two arguments: the name of the option,
1110 and the value to be assigned. It is up to the subroutine to store the
1111 value, or do whatever it thinks is appropriate.
1113 A trivial application of this mechanism is to implement options that
1114 are related to each other. For example:
1116 my $verbose = ''; # option variable with default value (false)
1117 GetOptions ('verbose' => \$verbose,
1118 'quiet' => sub { $verbose = 0 });
1120 Here C<--verbose> and C<--quiet> control the same variable
1121 C<$verbose>, but with opposite values.
1123 If the subroutine needs to signal an error, it should call die() with
1124 the desired error message as its argument. GetOptions() will catch the
1125 die(), issue the error message, and record that an error result must
1126 be returned upon completion.
1128 It is also possible for a user-defined subroutine to preliminary
1129 terminate options processing by calling die() with argument
1130 C<"FINISH">. GetOptions will react as if it encountered a double dash
1133 =head2 Options with multiple names
1135 Often it is user friendly to supply alternate mnemonic names for
1136 options. For example C<--height> could be an alternate name for
1137 C<--length>. Alternate names can be included in the option
1138 specification, separated by vertical bar C<|> characters. To implement
1141 GetOptions ('length|height=f' => \$length);
1143 The first name is called the I<primary> name, the other names are
1146 Multiple alternate names are possible.
1148 =head2 Case and abbreviations
1150 Without additional configuration, GetOptions() will ignore the case of
1151 option names, and allow the options to be abbreviated to uniqueness.
1153 GetOptions ('length|height=f' => \$length, "head" => \$head);
1155 This call will allow C<--l> and C<--L> for the length option, but
1156 requires a least C<--hea> and C<--hei> for the head and height options.
1158 =head2 Summary of Option Specifications
1160 Each option specifier consists of two parts: the name specification
1161 and the argument specification.
1163 The name specification contains the name of the option, optionally
1164 followed by a list of alternative names separated by vertical bar
1167 length option name is "length"
1168 length|size|l name is "length", aliases are "size" and "l"
1170 The argument specification is optional. If omitted, the option is
1171 considered boolean, a value of 1 will be assigned when the option is
1172 used on the command line.
1174 The argument specification can be
1180 The option does not take an argument and may be negated, i.e. prefixed
1181 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
1182 assigned) and C<--nofoo> (a value of 0 will be assigned).
1186 The option does not take an argument and will be incremented by 1
1187 every time it appears on the command line. E.g. C<"more+">, when used
1188 with C<--more --more --more>, will increment the value three times,
1189 resulting in a value of 3 (provided it was 0 or undefined at first).
1191 The C<+> specifier is ignored if the option destination is not a scalar.
1193 =item = I<type> [ I<desttype> ]
1195 The option requires an argument of the given type. Supported types
1202 String. An arbitrary sequence of characters. It is valid for the
1203 argument to start with C<-> or C<-->.
1207 Integer. An optional leading plus or minus sign, followed by a
1212 Real number. For example C<3.14>, C<-6.23E24> and so on.
1216 The I<desttype> can be C<@> or C<%> to specify that the option is
1217 list or a hash valued. This is only needed when the destination for
1218 the option value is not otherwise specified. It should be omitted when
1221 =item : I<type> [ I<desttype> ]
1223 Like C<=>, but designates the argument as optional.
1224 If omitted, an empty string will be assigned to string values options,
1225 and the value zero to numeric options.
1227 Note that if a string argument starts with C<-> or C<-->, it will be
1228 considered an option on itself.
1232 =head1 Advanced Possibilities
1234 =head2 Documentation and help texts
1236 Getopt::Long encourages the use of Pod::Usage to produce help
1237 messages. For example:
1245 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1246 pod2usage(1) if $help;
1247 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
1253 sample - Using GetOpt::Long and Pod::Usage
1257 sample [options] [file ...]
1260 -help brief help message
1261 -man full documentation
1269 Print a brief help message and exits.
1273 Prints the manual page and exits.
1279 B<This program> will read the given input file(s) and do someting
1280 useful with the contents thereof.
1284 See L<Pod::Usage> for details.
1286 =head2 Storing options in a hash
1288 Sometimes, for example when there are a lot of options, having a
1289 separate variable for each of them can be cumbersome. GetOptions()
1290 supports, as an alternative mechanism, storing options in a hash.
1292 To obtain this, a reference to a hash must be passed I<as the first
1293 argument> to GetOptions(). For each option that is specified on the
1294 command line, the option value will be stored in the hash with the
1295 option name as key. Options that are not actually used on the command
1296 line will not be put in the hash, on other words,
1297 C<exists($h{option})> (or defined()) can be used to test if an option
1298 was used. The drawback is that warnings will be issued if the program
1299 runs under C<use strict> and uses C<$h{option}> without testing with
1300 exists() or defined() first.
1303 GetOptions (\%h, 'length=i'); # will store in $h{length}
1305 For options that take list or hash values, it is necessary to indicate
1306 this by appending an C<@> or C<%> sign after the type:
1308 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
1310 To make things more complicated, the hash may contain references to
1311 the actual destinations, for example:
1314 my %h = ('length' => \$len);
1315 GetOptions (\%h, 'length=i'); # will store in $len
1317 This example is fully equivalent with:
1320 GetOptions ('length=i' => \$len); # will store in $len
1322 Any mixture is possible. For example, the most frequently used options
1323 could be stored in variables while all other options get stored in the
1326 my $verbose = 0; # frequently referred
1327 my $debug = 0; # frequently referred
1328 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1329 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1330 if ( $verbose ) { ... }
1331 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
1335 With bundling it is possible to set several single-character options
1336 at once. For example if C<a>, C<v> and C<x> are all valid options,
1340 would set all three.
1342 Getopt::Long supports two levels of bundling. To enable bundling, a
1343 call to Getopt::Long::Configure is required.
1345 The first level of bundling can be enabled with:
1347 Getopt::Long::Configure ("bundling");
1349 Configured this way, single-character options can be bundled but long
1350 options B<must> always start with a double dash C<--> to avoid
1351 abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1356 would set C<a>, C<v> and C<x>, but
1362 The second level of bundling lifts this restriction. It can be enabled
1365 Getopt::Long::Configure ("bundling_override");
1367 Now, C<-vax> would set the option C<vax>.
1369 When any level of bundling is enabled, option values may be inserted
1370 in the bundle. For example:
1378 When configured for bundling, single-character options are matched
1379 case sensitive while long options are matched case insensitive. To
1380 have the single-character options matched case insensitive as well,
1383 Getopt::Long::Configure ("bundling", "ignorecase_always");
1385 It goes without saying that bundling can be quite confusing.
1387 =head2 The lonesome dash
1389 Some applications require the option C<-> (that's a lone dash). This
1390 can be achieved by adding an option specification with an empty name:
1392 GetOptions ('' => \$stdio);
1394 A lone dash on the command line will now be legal, and set options
1397 =head2 Argument call-back
1399 A special option 'name' C<<>> can be used to designate a subroutine
1400 to handle non-option arguments. When GetOptions() encounters an
1401 argument that does not look like an option, it will immediately call this
1402 subroutine and passes it the argument as a parameter.
1408 GetOptions ('width=i' => \$width, '<>' => \&process);
1410 When applied to the following command line:
1412 arg1 --width=72 arg2 --width=60 arg3
1415 C<process("arg1")> while C<$width> is C<80>,
1416 C<process("arg2")> while C<$width> is C<72>, and
1417 C<process("arg3")> while C<$width> is C<60>.
1419 This feature requires configuration option B<permute>, see section
1420 L<Configuring Getopt::Long>.
1423 =head1 Configuring Getopt::Long
1425 Getopt::Long can be configured by calling subroutine
1426 Getopt::Long::Configure(). This subroutine takes a list of quoted
1427 strings, each specifying a configuration option to be set, e.g.
1428 C<ignore_case>, or reset, e.g. C<no_ignore_case>. Case does not
1429 matter. Multiple calls to Configure() are possible.
1431 The following options are available:
1437 This option causes all configuration options to be reset to their
1442 Allow option names to be abbreviated to uniqueness.
1443 Default is set unless environment variable
1444 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is reset.
1448 Allow C<+> to start options.
1449 Default is set unless environment variable
1450 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is reset.
1454 Whether command line arguments are allowed to be mixed with options.
1455 Default is set unless environment variable
1456 POSIXLY_CORRECT has been set, in which case C<require_order> is reset.
1458 See also C<permute>, which is the opposite of C<require_order>.
1462 Whether command line arguments are allowed to be mixed with options.
1463 Default is set unless environment variable
1464 POSIXLY_CORRECT has been set, in which case C<permute> is reset.
1465 Note that C<permute> is the opposite of C<require_order>.
1467 If C<permute> is set, this means that
1469 --foo arg1 --bar arg2 arg3
1473 --foo --bar arg1 arg2 arg3
1475 If an argument call-back routine is specified, C<@ARGV> will always be
1476 empty upon succesful return of GetOptions() since all options have been
1477 processed. The only exception is when C<--> is used:
1479 --foo arg1 --bar arg2 -- arg3
1481 will call the call-back routine for arg1 and arg2, and terminate
1482 GetOptions() leaving C<"arg2"> in C<@ARGV>.
1484 If C<require_order> is set, options processing
1485 terminates when the first non-option is encountered.
1487 --foo arg1 --bar arg2 arg3
1491 --foo -- arg1 --bar arg2 arg3
1493 =item bundling (default: reset)
1495 Setting this option will allow single-character options to be bundled.
1496 To distinguish bundles from long option names, long options I<must> be
1497 introduced with C<--> and single-character options (and bundles) with
1500 Note: resetting C<bundling> also resets C<bundling_override>.
1502 =item bundling_override (default: reset)
1504 If C<bundling_override> is set, bundling is enabled as with
1505 C<bundling> but now long option names override option bundles.
1507 Note: resetting C<bundling_override> also resets C<bundling>.
1509 B<Note:> Using option bundling can easily lead to unexpected results,
1510 especially when mixing long options and bundles. Caveat emptor.
1512 =item ignore_case (default: set)
1514 If set, case is ignored when matching long option names. Single
1515 character options will be treated case-sensitive.
1517 Note: resetting C<ignore_case> also resets C<ignore_case_always>.
1519 =item ignore_case_always (default: reset)
1521 When bundling is in effect, case is ignored on single-character
1524 Note: resetting C<ignore_case_always> also resets C<ignore_case>.
1526 =item pass_through (default: reset)
1528 Options that are unknown, ambiguous or supplied with an invalid option
1529 value are passed through in C<@ARGV> instead of being flagged as
1530 errors. This makes it possible to write wrapper scripts that process
1531 only part of the user supplied command line arguments, and pass the
1532 remaining options to some other program.
1534 This can be very confusing, especially when C<permute> is also set.
1538 The string that starts options. If a constant string is not
1539 sufficient, see C<prefix_pattern>.
1541 =item prefix_pattern
1543 A Perl pattern that identifies the strings that introduce options.
1544 Default is C<(--|-|\+)> unless environment variable
1545 POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1547 =item debug (default: reset)
1549 Enable copious debugging output.
1553 =head1 Return values and Errors
1555 Configuration errors and errors in the option definitions are
1556 signalled using die() and will terminate the calling program unless
1557 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
1558 }>, or die() was trapped using C<$SIG{__DIE__}>.
1560 A return value of 1 (true) indicates success.
1562 A return status of 0 (false) indicates that the function detected one
1563 or more errors during option parsing. These errors are signalled using
1564 warn() and can be trapped with C<$SIG{__WARN__}>.
1566 Errors that can't happen are signalled using Carp::croak().
1570 The earliest development of C<newgetopt.pl> started in 1990, with Perl
1571 version 4. As a result, its development, and the development of
1572 Getopt::Long, has gone through several stages. Since backward
1573 compatibility has always been extremely important, the current version
1574 of Getopt::Long still supports a lot of constructs that nowadays are
1575 no longer necessary or otherwise unwanted. This section describes
1576 briefly some of these 'features'.
1578 =head2 Default destinations
1580 When no destination is specified for an option, GetOptions will store
1581 the resultant value in a global variable named C<opt_>I<XXX>, where
1582 I<XXX> is the primary name of this option. When a progam executes
1583 under C<use strict> (recommended), these variables must be
1584 pre-declared with our() or C<use vars>.
1586 our $opt_length = 0;
1587 GetOptions ('length=i'); # will store in $opt_length
1589 To yield a usable Perl variable, characters that are not part of the
1590 syntax for variables are translated to underscores. For example,
1591 C<--fpp-struct-return> will set the variable
1592 C<$opt_fpp_struct_return>. Note that this variable resides in the
1593 namespace of the calling program, not necessarily C<main>. For
1596 GetOptions ("size=i", "sizes=i@");
1598 with command line "-size 10 -sizes 24 -sizes 48" will perform the
1599 equivalent of the assignments
1602 @opt_sizes = (24, 48);
1604 =head2 Alternative option starters
1606 A string of alternative option starter characters may be passed as the
1607 first argument (or the first argument after a leading hash reference
1611 GetOptions ('/', 'length=i' => $len);
1613 Now the command line may look like:
1617 Note that to terminate options processing still requires a double dash
1620 GetOptions() will not interpret a leading C<"<>"> as option starters
1621 if the next argument is a reference. To force C<"<"> and C<">"> as
1622 option starters, use C<"><">. Confusing? Well, B<using a starter
1623 argument is strongly deprecated> anyway.
1625 =head2 Configuration variables
1627 Previous versions of Getopt::Long used variables for the purpose of
1628 configuring. Although manipulating these variables still work, it
1629 is strongly encouraged to use the new C<config> routine. Besides, it
1634 Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
1636 =head1 COPYRIGHT AND DISCLAIMER
1638 This program is Copyright 2000,1990 by Johan Vromans.
1639 This program is free software; you can redistribute it and/or
1640 modify it under the terms of the Perl Artistic License or the
1641 GNU General Public License as published by the Free Software
1642 Foundation; either version 2 of the License, or (at your option) any
1645 This program is distributed in the hope that it will be useful,
1646 but WITHOUT ANY WARRANTY; without even the implied warranty of
1647 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
1648 GNU General Public License for more details.
1650 If you do not have a copy of the GNU General Public License write to
1651 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
1658 # eval: (load-file "pod.el")