-# GetOpt::Long.pm -- Universal options parsing
+# Getopt::Long.pm -- Universal options parsing
package Getopt::Long;
-# RCS Status : $Id: GetoptLong.pm,v 2.16 1998-03-13 11:05:29+01 jv Exp $
+# RCS Status : $Id: GetoptLong.pm,v 2.68 2003-09-23 15:24:53+02 jv Exp jv $
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Fri Mar 13 11:05:28 1998
-# Update Count : 659
+# Last Modified On: Wed Dec 31 20:48:15 2003
+# Update Count : 1440
# Status : Released
################ Copyright ################
-# This program is Copyright 1990,1998 by Johan Vromans.
+# This program is Copyright 1990,2002 by Johan Vromans.
# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License
-# as published by the Free Software Foundation; either version 2
-# of the License, or (at your option) any later version.
-#
+# modify it under the terms of the Perl Artistic License or the
+# GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any
+# later version.
+#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
-#
+#
# If you do not have a copy of the GNU General Public License write to
-# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
+# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
# MA 02139, USA.
################ Module Preamble ################
+use 5.004;
+
use strict;
-BEGIN {
- require 5.004;
- use Exporter ();
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
- $VERSION = sprintf("%d.%02d", q$Revision: 2.16 $ =~ /(\d+)\.(\d+)/);
+use vars qw($VERSION);
+$VERSION = 2.3401;
+# For testing versions only.
+use vars qw($VERSION_STRING);
+$VERSION_STRING = "2.34_01";
+
+use Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+@ISA = qw(Exporter);
+
+# Exported subroutines.
+sub GetOptions(@); # always
+sub Configure(@); # on demand
+sub HelpMessage(@); # on demand
+sub VersionMessage(@); # in demand
- @ISA = qw(Exporter);
+BEGIN {
+ # Init immediately so their contents can be used in the 'use vars' below.
@EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
- %EXPORT_TAGS = ();
- @EXPORT_OK = qw();
+ @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure);
}
-use vars @EXPORT, @EXPORT_OK;
# User visible variables.
+use vars @EXPORT, @EXPORT_OK;
use vars qw($error $debug $major_version $minor_version);
# Deprecated visible variables.
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
$passthrough);
+# Official invisible variables.
+use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version);
+
+# Public subroutines.
+sub config(@); # deprecated name
+
+# Private subroutines.
+sub ConfigDefaults();
+sub ParseOptionSpec($$);
+sub OptCtl($);
+sub FindOption($$$$);
+sub ValidValue ($$$$$);
################ Local Variables ################
-my $gen_prefix; # generic prefix (option starters)
-my $argend; # option list terminator
-my %opctl; # table of arg.specs (long and abbrevs)
-my %bopctl; # table of arg.specs (bundles)
-my @opctl; # the possible long option names
-my $pkg; # current context. Needed if no linkage.
-my %aliases; # alias table
-my $genprefix; # so we can call the same module more
-my $opt; # current option
-my $arg; # current option value, if any
-my $array; # current option is array typed
-my $hash; # current option is hash typed
-my $key; # hash key for a hash option
- # than once in differing environments
-my $config_defaults; # set config defaults
-my $find_option; # helper routine
-my $croak; # helper routine
-
-################ Subroutines ################
-
-sub GetOptions {
+# $requested_version holds the version that was mentioned in the 'use'
+# or 'require', if any. It can be used to enable or disable specific
+# features.
+my $requested_version = 0;
+
+################ Resident subroutines ################
+
+sub ConfigDefaults() {
+ # Handle POSIX compliancy.
+ if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+ $genprefix = "(--|-)";
+ $autoabbrev = 0; # no automatic abbrev of options
+ $bundling = 0; # no bundling of single letter switches
+ $getopt_compat = 0; # disallow '+' to start options
+ $order = $REQUIRE_ORDER;
+ }
+ else {
+ $genprefix = "(--|-|\\+)";
+ $autoabbrev = 1; # automatic abbrev of options
+ $bundling = 0; # bundling off by default
+ $getopt_compat = 1; # allow '+' to start options
+ $order = $PERMUTE;
+ }
+ # Other configurable settings.
+ $debug = 0; # for debugging
+ $error = 0; # error tally
+ $ignorecase = 1; # ignore case when matching options
+ $passthrough = 0; # leave unrecognized options alone
+ $gnu_compat = 0; # require --opt=val if value is optional
+}
+
+# Override import.
+sub import {
+ my $pkg = shift; # package
+ my @syms = (); # symbols to import
+ my @config = (); # configuration
+ my $dest = \@syms; # symbols first
+ for ( @_ ) {
+ if ( $_ eq ':config' ) {
+ $dest = \@config; # config next
+ next;
+ }
+ push(@$dest, $_); # push
+ }
+ # Hide one level and call super.
+ local $Exporter::ExportLevel = 1;
+ push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
+ $pkg->SUPER::import(@syms);
+ # And configure.
+ Configure(@config) if @config;
+}
+
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+ConfigDefaults();
+
+################ OO Interface ################
+
+package Getopt::Long::Parser;
+
+# Store a copy of the default configuration. Since ConfigDefaults has
+# just been called, what we get from Configure is the default.
+my $default_config = do {
+ Getopt::Long::Configure ()
+};
+
+sub new {
+ my $that = shift;
+ my $class = ref($that) || $that;
+ my %atts = @_;
+
+ # Register the callers package.
+ my $self = { caller_pkg => (caller)[0] };
+
+ bless ($self, $class);
+
+ # Process config attributes.
+ if ( defined $atts{config} ) {
+ my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
+ $self->{settings} = Getopt::Long::Configure ($save);
+ delete ($atts{config});
+ }
+ # Else use default config.
+ else {
+ $self->{settings} = $default_config;
+ }
+
+ if ( %atts ) { # Oops
+ die(__PACKAGE__.": unhandled attributes: ".
+ join(" ", sort(keys(%atts)))."\n");
+ }
+
+ $self;
+}
+
+sub configure {
+ my ($self) = shift;
+
+ # Restore settings, merge new settings in.
+ my $save = Getopt::Long::Configure ($self->{settings}, @_);
+
+ # Restore orig config and save the new config.
+ $self->{settings} = Getopt::Long::Configure ($save);
+}
+
+sub getoptions {
+ my ($self) = shift;
+
+ # Restore config settings.
+ my $save = Getopt::Long::Configure ($self->{settings});
+
+ # Call main routine.
+ my $ret = 0;
+ $Getopt::Long::caller = $self->{caller_pkg};
+
+ eval {
+ # Locally set exception handler to default, otherwise it will
+ # be called implicitly here, and again explicitly when we try
+ # to deliver the messages.
+ local ($SIG{__DIE__}) = '__DEFAULT__';
+ $ret = Getopt::Long::GetOptions (@_);
+ };
+
+ # Restore saved settings.
+ Getopt::Long::Configure ($save);
+
+ # Handle errors and return value.
+ die ($@) if $@;
+ return $ret;
+}
+
+package Getopt::Long;
+
+################ Back to Normal ################
+
+# Indices in option control info.
+# Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
+use constant CTL_TYPE => 0;
+#use constant CTL_TYPE_FLAG => '';
+#use constant CTL_TYPE_NEG => '!';
+#use constant CTL_TYPE_INCR => '+';
+#use constant CTL_TYPE_INT => 'i';
+#use constant CTL_TYPE_INTINC => 'I';
+#use constant CTL_TYPE_XINT => 'o';
+#use constant CTL_TYPE_FLOAT => 'f';
+#use constant CTL_TYPE_STRING => 's';
+
+use constant CTL_CNAME => 1;
+
+use constant CTL_DEFAULT => 2;
+
+use constant CTL_DEST => 3;
+ use constant CTL_DEST_SCALAR => 0;
+ use constant CTL_DEST_ARRAY => 1;
+ use constant CTL_DEST_HASH => 2;
+ use constant CTL_DEST_CODE => 3;
+
+use constant CTL_AMIN => 4;
+use constant CTL_AMAX => 5;
+
+# FFU.
+#use constant CTL_RANGE => ;
+#use constant CTL_REPEAT => ;
+
+sub GetOptions(@) {
my @optionlist = @_; # local copy of the option descriptions
- $argend = '--'; # option list terminator
- %opctl = (); # table of arg.specs (long and abbrevs)
- %bopctl = (); # table of arg.specs (bundles)
- $pkg = (caller)[0]; # current context
+ my $argend = '--'; # option list terminator
+ my %opctl = (); # table of option specs
+ my $pkg = $caller || (caller)[0]; # current context
# Needed if linkage is omitted.
- %aliases= (); # alias table
my @ret = (); # accum for non-options
my %linkage; # linkage
my $userlinkage; # user supplied HASH
- $genprefix = $gen_prefix; # so we can call the same module many times
+ my $opt; # current option
+ my $prefix = $genprefix; # current prefix
+
$error = '';
- print STDERR ('GetOptions $Revision: 2.16 $ ',
- "[GetOpt::Long $Getopt::Long::VERSION] -- ",
- "called from package \"$pkg\".\n",
- " (@ARGV)\n",
- " autoabbrev=$autoabbrev".
- ",bundling=$bundling",
- ",getopt_compat=$getopt_compat",
- ",order=$order",
- ",\n ignorecase=$ignorecase",
- ",passthrough=$passthrough",
- ",genprefix=\"$genprefix\"",
- ".\n")
- if $debug;
-
- # Check for ref HASH as first argument.
+ if ( $debug ) {
+ # Avoid some warnings if debugging.
+ local ($^W) = 0;
+ print STDERR
+ ("Getopt::Long $Getopt::Long::VERSION (",
+ '$Revision: 2.68 $', ") ",
+ "called from package \"$pkg\".",
+ "\n ",
+ "ARGV: (@ARGV)",
+ "\n ",
+ "autoabbrev=$autoabbrev,".
+ "bundling=$bundling,",
+ "getopt_compat=$getopt_compat,",
+ "gnu_compat=$gnu_compat,",
+ "order=$order,",
+ "\n ",
+ "ignorecase=$ignorecase,",
+ "requested_version=$requested_version,",
+ "passthrough=$passthrough,",
+ "genprefix=\"$genprefix\".",
+ "\n");
+ }
+
+ # Check for ref HASH as first argument.
# First argument may be an object. It's OK to use this as long
- # as it is really a hash underneath.
+ # as it is really a hash underneath.
$userlinkage = undef;
- if ( ref($optionlist[0]) and
+ if ( @optionlist && ref($optionlist[0]) and
"$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
$userlinkage = shift (@optionlist);
print STDERR ("=> user linkage: $userlinkage\n") if $debug;
# See if the first element of the optionlist contains option
# starter characters.
- if ( $optionlist[0] =~ /^\W+$/ ) {
- $genprefix = shift (@optionlist);
+ # Be careful not to interpret '<>' as option starters.
+ if ( @optionlist && $optionlist[0] =~ /^\W+$/
+ && !($optionlist[0] eq '<>'
+ && @optionlist > 0
+ && ref($optionlist[1])) ) {
+ $prefix = shift (@optionlist);
# Turn into regexp. Needs to be parenthesized!
- $genprefix =~ s/(\W)/\\$1/g;
- $genprefix = "([" . $genprefix . "])";
+ $prefix =~ s/(\W)/\\$1/g;
+ $prefix = "([" . $prefix . "])";
+ print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
}
# Verify correctness of optionlist.
%opctl = ();
- %bopctl = ();
- while ( @optionlist > 0 ) {
+ while ( @optionlist ) {
my $opt = shift (@optionlist);
# Strip leading prefix so people can specify "--foo=i" if they like.
- $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
+ $opt = $+ if $opt =~ /^$prefix+(.*)$/s;
if ( $opt eq '<>' ) {
if ( (defined $userlinkage)
&& ref($userlinkage->{$opt}) ) {
unshift (@optionlist, $userlinkage->{$opt});
}
- unless ( @optionlist > 0
+ unless ( @optionlist > 0
&& ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
$error .= "Option spec <> requires a reference to a subroutine\n";
+ # Kill the linkage (to avoid another error).
+ shift (@optionlist)
+ if @optionlist && ref($optionlist[0]);
next;
}
$linkage{'<>'} = shift (@optionlist);
next;
}
- # Match option spec. Allow '?' as an alias.
- if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?(!|[=:][infse][@%]?)?$/ ) {
- $error .= "Error in option spec: \"$opt\"\n";
+ # Parse option spec.
+ my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
+ unless ( defined $name ) {
+ # Failed. $orig contains the error message. Sorry for the abuse.
+ $error .= $orig;
+ # Kill the linkage (to avoid another error).
+ shift (@optionlist)
+ if @optionlist && ref($optionlist[0]);
next;
}
- my ($o, $c, $a) = ($1, $5);
- $c = '' unless defined $c;
-
- if ( ! defined $o ) {
- # empty -> '-' option
- $opctl{$o = ''} = $c;
- }
- else {
- # Handle alias names
- my @o = split (/\|/, $o);
- my $linko = $o = $o[0];
- # Force an alias if the option name is not locase.
- $a = $o unless $o eq lc($o);
- $o = lc ($o)
- if $ignorecase > 1
- || ($ignorecase
- && ($bundling ? length($o) > 1 : 1));
-
- foreach ( @o ) {
- if ( $bundling && length($_) == 1 ) {
- $_ = lc ($_) if $ignorecase > 1;
- if ( $c eq '!' ) {
- $opctl{"no$_"} = $c;
- warn ("Ignoring '!' modifier for short option $_\n");
- $c = '';
- }
- $opctl{$_} = $bopctl{$_} = $c;
- }
- else {
- $_ = lc ($_) if $ignorecase;
- if ( $c eq '!' ) {
- $opctl{"no$_"} = $c;
- $c = '';
- }
- $opctl{$_} = $c;
- }
- if ( defined $a ) {
- # Note alias.
- $aliases{$_} = $a;
- }
- else {
- # Set primary name.
- $a = $_;
- }
- }
- $o = $linko;
- }
# If no linkage is supplied in the @optionlist, copy it from
# the userlinkage if available.
if ( defined $userlinkage ) {
unless ( @optionlist > 0 && ref($optionlist[0]) ) {
- if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
- print STDERR ("=> found userlinkage for \"$o\": ",
- "$userlinkage->{$o}\n")
+ if ( exists $userlinkage->{$orig} &&
+ ref($userlinkage->{$orig}) ) {
+ print STDERR ("=> found userlinkage for \"$orig\": ",
+ "$userlinkage->{$orig}\n")
if $debug;
- unshift (@optionlist, $userlinkage->{$o});
+ unshift (@optionlist, $userlinkage->{$orig});
}
else {
# Do nothing. Being undefined will be handled later.
# Copy the linkage. If omitted, link to global variable.
if ( @optionlist > 0 && ref($optionlist[0]) ) {
- print STDERR ("=> link \"$o\" to $optionlist[0]\n")
+ print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
if $debug;
- if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
- $linkage{$o} = shift (@optionlist);
+ my $rl = ref($linkage{$orig} = shift (@optionlist));
+
+ if ( $rl eq "ARRAY" ) {
+ $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
+ }
+ elsif ( $rl eq "HASH" ) {
+ $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
}
- elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
- $linkage{$o} = shift (@optionlist);
- $opctl{$o} .= '@'
- if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
- $bopctl{$o} .= '@'
- if $bundling and defined $bopctl{$o} and
- $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
+ elsif ( $rl eq "SCALAR" ) {
+# if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
+# my $t = $linkage{$orig};
+# $$t = $linkage{$orig} = [];
+# }
+# elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
+# }
+# else {
+ # Ok.
+# }
}
- elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
- $linkage{$o} = shift (@optionlist);
- $opctl{$o} .= '%'
- if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
- $bopctl{$o} .= '%'
- if $bundling and defined $bopctl{$o} and
- $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
+ elsif ( $rl eq "CODE" ) {
+ # Ok.
}
else {
$error .= "Invalid option linkage for \"$opt\"\n";
else {
# Link to global $opt_XXX variable.
# Make sure a valid perl identifier results.
- my $ov = $o;
+ my $ov = $orig;
$ov =~ s/\W/_/g;
- if ( $c =~ /@/ ) {
- print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
+ if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
+ print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
if $debug;
- eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
+ eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
}
- elsif ( $c =~ /%/ ) {
- print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
+ elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
+ print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
if $debug;
- eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
+ eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
}
else {
- print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
+ print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
if $debug;
- eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
+ eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
}
}
}
die ($error) if $error;
$error = 0;
- # Sort the possible long option names.
- @opctl = sort(keys (%opctl)) if $autoabbrev;
+ # Supply --version and --help support, if needed and allowed.
+ if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
+ if ( !defined($opctl{version}) ) {
+ $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
+ $linkage{version} = \&VersionMessage;
+ }
+ $auto_version = 1;
+ }
+ if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
+ if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
+ $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
+ $linkage{help} = \&HelpMessage;
+ }
+ $auto_help = 1;
+ }
# Show the options tables if debugging.
if ( $debug ) {
my ($arrow, $k, $v);
$arrow = "=> ";
while ( ($k,$v) = each(%opctl) ) {
- print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
- $arrow = " ";
- }
- $arrow = "=> ";
- while ( ($k,$v) = each(%bopctl) ) {
- print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
+ print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
$arrow = " ";
}
}
# Process argument list
- while ( @ARGV > 0 ) {
-
- #### Get next argument ####
+ my $goon = 1;
+ while ( $goon && @ARGV > 0 ) {
+ # Get next argument.
$opt = shift (@ARGV);
- $arg = undef;
- $array = $hash = 0;
- print STDERR ("=> option \"", $opt, "\"\n") if $debug;
-
- #### Determine what we have ####
+ print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
# Double dash is option list terminator.
if ( $opt eq $argend ) {
- # Finish. Push back accumulated arguments and return.
- unshift (@ARGV, @ret)
- if $order == $PERMUTE;
- return ($error == 0);
+ push (@ret, $argend) if $passthrough;
+ last;
}
+ # Look it up.
my $tryopt = $opt;
+ my $found; # success status
+ my $key; # key (if hash type)
+ my $arg; # option argument
+ my $ctl; # the opctl entry
- # find_option operates on the GLOBAL $opt and $arg!
- if ( &$find_option () ) {
-
- # find_option undefines $opt in case of errors.
+ ($found, $opt, $ctl, $arg, $key) =
+ FindOption ($prefix, $argend, $opt, \%opctl);
+
+ if ( $found ) {
+
+ # FindOption undefines $opt in case of errors.
next unless defined $opt;
- if ( defined $arg ) {
- $opt = $aliases{$opt} if defined $aliases{$opt};
+ my $argcnt = 0;
+ while ( defined $arg ) {
+
+ # Get the canonical name.
+ print STDERR ("=> cname for \"$opt\" is ") if $debug;
+ $opt = $ctl->[CTL_CNAME];
+ print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
if ( defined $linkage{$opt} ) {
print STDERR ("=> ref(\$L{$opt}) -> ",
ref($linkage{$opt}), "\n") if $debug;
if ( ref($linkage{$opt}) eq 'SCALAR' ) {
- print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
- ${$linkage{$opt}} = $arg;
+ if ( $ctl->[CTL_TYPE] eq '+' ) {
+ print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
+ if $debug;
+ if ( defined ${$linkage{$opt}} ) {
+ ${$linkage{$opt}} += $arg;
+ }
+ else {
+ ${$linkage{$opt}} = $arg;
+ }
+ }
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
+ print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+ " to ARRAY\n")
+ if $debug;
+ my $t = $linkage{$opt};
+ $$t = $linkage{$opt} = [];
+ print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+ if $debug;
+ push (@{$linkage{$opt}}, $arg);
+ }
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+ print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+ " to HASH\n")
+ if $debug;
+ my $t = $linkage{$opt};
+ $$t = $linkage{$opt} = {};
+ print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+ if $debug;
+ $linkage{$opt}->{$key} = $arg;
+ }
+ else {
+ print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
+ if $debug;
+ ${$linkage{$opt}} = $arg;
+ }
}
elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
$linkage{$opt}->{$key} = $arg;
}
elsif ( ref($linkage{$opt}) eq 'CODE' ) {
- print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
+ print STDERR ("=> &L{$opt}(\"$opt\"",
+ $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
+ ", \"$arg\")\n")
if $debug;
- &{$linkage{$opt}}($opt, $arg);
+ my $eval_error = do {
+ local $@;
+ local $SIG{__DIE__} = '__DEFAULT__';
+ eval {
+ &{$linkage{$opt}}($opt,
+ $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+ $arg);
+ };
+ $@;
+ };
+ print STDERR ("=> die($eval_error)\n")
+ if $debug && $eval_error ne '';
+ if ( $eval_error =~ /^!/ ) {
+ if ( $eval_error =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
+ }
+ elsif ( $eval_error ne '' ) {
+ warn ($eval_error);
+ $error++;
+ }
}
else {
print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
"\" in linkage\n");
- &$croak ("Getopt::Long -- internal error!\n");
+ die("Getopt::Long -- internal error!\n");
}
}
# No entry in linkage means entry in userlinkage.
- elsif ( $array ) {
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
if $debug;
$userlinkage->{$opt} = [$arg];
}
}
- elsif ( $hash ) {
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
if $debug;
}
}
else {
- print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
- $userlinkage->{$opt} = $arg;
+ if ( $ctl->[CTL_TYPE] eq '+' ) {
+ print STDERR ("=> \$L{$opt} += \"$arg\"\n")
+ if $debug;
+ if ( defined $userlinkage->{$opt} ) {
+ $userlinkage->{$opt} += $arg;
+ }
+ else {
+ $userlinkage->{$opt} = $arg;
+ }
+ }
+ else {
+ print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+ $userlinkage->{$opt} = $arg;
+ }
+ }
+
+ $argcnt++;
+ last if $argcnt >= $ctl->[CTL_AMAX];
+ undef($arg);
+
+ # Need more args?
+ if ( $argcnt < $ctl->[CTL_AMIN] ) {
+ if ( @ARGV ) {
+ if ( ValidValue($ctl, $ARGV[0], 1, $argend, $prefix) ) {
+ $arg = shift(@ARGV);
+ ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+ if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+ next;
+ }
+ warn("Value \"$ARGV[0]\" invalid for option $opt\n");
+ $error++;
+ }
+ else {
+ warn("Insufficient arguments for option $opt\n");
+ $error++;
+ }
+ }
+
+ # Any more args?
+ if ( @ARGV && ValidValue($ctl, $ARGV[0], 0, $argend, $prefix) ) {
+ $arg = shift(@ARGV);
+ ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+ if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+ next;
}
}
}
# Try non-options call-back.
my $cb;
if ( (defined ($cb = $linkage{'<>'})) ) {
- &$cb ($tryopt);
+ print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
+ if $debug;
+ my $eval_error = do {
+ local $@;
+ local $SIG{__DIE__} = '__DEFAULT__';
+ eval { &$cb ($tryopt) };
+ $@;
+ };
+ print STDERR ("=> die($eval_error)\n")
+ if $debug && $eval_error ne '';
+ if ( $eval_error =~ /^!/ ) {
+ if ( $eval_error =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
+ }
+ elsif ( $eval_error ne '' ) {
+ warn ($eval_error);
+ $error++;
+ }
}
else {
print STDERR ("=> saving \"$tryopt\" ",
}
# Finish.
- if ( $order == $PERMUTE ) {
+ if ( @ret && $order == $PERMUTE ) {
# Push back accumulated arguments
print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
- if $debug && @ret > 0;
- unshift (@ARGV, @ret) if @ret > 0;
+ if $debug;
+ unshift (@ARGV, @ret);
}
return ($error == 0);
}
-sub config (@) {
- my (@options) = @_;
- my $opt;
- foreach $opt ( @options ) {
- my $try = lc ($opt);
- my $action = 1;
- if ( $try =~ /^no_?(.*)$/s ) {
- $action = 0;
- $try = $+;
- }
- if ( $try eq 'default' or $try eq 'defaults' ) {
- &$config_defaults () if $action;
- }
- elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
- $autoabbrev = $action;
- }
- elsif ( $try eq 'getopt_compat' ) {
- $getopt_compat = $action;
- }
- elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
- $ignorecase = $action;
- }
- elsif ( $try eq 'ignore_case_always' ) {
- $ignorecase = $action ? 2 : 0;
- }
- elsif ( $try eq 'bundling' ) {
- $bundling = $action;
- }
- elsif ( $try eq 'bundling_override' ) {
- $bundling = $action ? 2 : 0;
- }
- elsif ( $try eq 'require_order' ) {
- $order = $action ? $REQUIRE_ORDER : $PERMUTE;
- }
- elsif ( $try eq 'permute' ) {
- $order = $action ? $PERMUTE : $REQUIRE_ORDER;
- }
- elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
- $passthrough = $action;
- }
- elsif ( $try =~ /^prefix=(.+)$/ ) {
- $gen_prefix = $1;
- # Turn into regexp. Needs to be parenthesized!
- $gen_prefix = "(" . quotemeta($gen_prefix) . ")";
- eval { '' =~ /$gen_prefix/; };
- &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
- }
- elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
- $gen_prefix = $1;
- # Parenthesize if needed.
- $gen_prefix = "(" . $gen_prefix . ")"
- unless $gen_prefix =~ /^\(.*\)$/;
- eval { '' =~ /$gen_prefix/; };
- &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
+# A readable representation of what's in an optbl.
+sub OptCtl ($) {
+ my ($v) = @_;
+ my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
+ "[".
+ join(",",
+ "\"$v[CTL_TYPE]\"",
+ "\"$v[CTL_CNAME]\"",
+ "\"$v[CTL_DEFAULT]\"",
+ ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
+ $v[CTL_AMIN] || '',
+ $v[CTL_AMAX] || '',
+# $v[CTL_RANGE] || '',
+# $v[CTL_REPEAT] || '',
+ ). "]";
+}
+
+# Parse an option specification and fill the tables.
+sub ParseOptionSpec ($$) {
+ my ($opt, $opctl) = @_;
+
+ # Match option spec.
+ if ( $opt !~ m;^
+ (
+ # Option name
+ (?: \w+[-\w]* )
+ # Alias names, or "?"
+ (?: \| (?: \? | \w[-\w]* )? )*
+ )?
+ (
+ # Either modifiers ...
+ [!+]
+ |
+ # ... or a value/dest/repeat specification
+ [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
+ |
+ # ... or an optional-with-default spec
+ : (?: -?\d+ | \+ ) [@%]?
+ )?
+ $;x ) {
+ return (undef, "Error in option spec: \"$opt\"\n");
+ }
+
+ my ($names, $spec) = ($1, $2);
+ $spec = '' unless defined $spec;
+
+ # $orig keeps track of the primary name the user specified.
+ # This name will be used for the internal or external linkage.
+ # In other words, if the user specifies "FoO|BaR", it will
+ # match any case combinations of 'foo' and 'bar', but if a global
+ # variable needs to be set, it will be $opt_FoO in the exact case
+ # as specified.
+ my $orig;
+
+ my @names;
+ if ( defined $names ) {
+ @names = split (/\|/, $names);
+ $orig = $names[0];
+ }
+ else {
+ @names = ('');
+ $orig = '';
+ }
+
+ # Construct the opctl entries.
+ my $entry;
+ if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
+ # Fields are hard-wired here.
+ $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
+ }
+ elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
+ my $def = $1;
+ my $dest = $2;
+ my $type = $def eq '+' ? 'I' : 'i';
+ $dest ||= '$';
+ $dest = $dest eq '@' ? CTL_DEST_ARRAY
+ : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+ # Fields are hard-wired here.
+ $entry = [$type,$orig,$def eq '+' ? undef : $def,
+ $dest,0,1];
+ }
+ else {
+ my ($mand, $type, $dest) =
+ $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
+ return (undef, "Cannot repeat while bundling: \"$opt\"\n")
+ if $bundling && defined($4);
+ my ($mi, $cm, $ma) = ($5, $6, $7);
+ return (undef, "{0} is useless in option spec: \"$opt\"\n")
+ if defined($mi) && !$mi && !defined($ma) && !defined($cm);
+
+ $type = 'i' if $type eq 'n';
+ $dest ||= '$';
+ $dest = $dest eq '@' ? CTL_DEST_ARRAY
+ : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+ # Default minargs to 1/0 depending on mand status.
+ $mi = $mand eq '=' ? 1 : 0 unless defined $mi;
+ # Adjust mand status according to minargs.
+ $mand = $mi ? '=' : ':';
+ # Adjust maxargs.
+ $ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
+ return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
+ if defined($ma) && !$ma;
+ return (undef, "Max less than min in option spec: \"$opt\"\n")
+ if defined($ma) && $ma < $mi;
+
+ # Fields are hard-wired here.
+ $entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
+ }
+
+ # Process all names. First is canonical, the rest are aliases.
+ my $dups = '';
+ foreach ( @names ) {
+
+ $_ = lc ($_)
+ if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
+
+ if ( exists $opctl->{$_} ) {
+ $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
}
- elsif ( $try eq 'debug' ) {
- $debug = $action;
+
+ if ( $spec eq '!' ) {
+ $opctl->{"no$_"} = $entry;
+ $opctl->{"no-$_"} = $entry;
+ $opctl->{$_} = [@$entry];
+ $opctl->{$_}->[CTL_TYPE] = '';
}
else {
- &$croak ("Getopt::Long: unknown config parameter \"$opt\"")
+ $opctl->{$_} = $entry;
}
}
+
+ if ( $dups && $^W ) {
+ foreach ( split(/\n+/, $dups) ) {
+ warn($_."\n");
+ }
+ }
+ ($names[0], $orig);
}
-# To prevent Carp from being loaded unnecessarily.
-$croak = sub {
- require 'Carp.pm';
- $Carp::CarpLevel = 1;
- Carp::croak(@_);
-};
+# Option lookup.
+sub FindOption ($$$$) {
-################ Private Subroutines ################
+ # returns (1, $opt, $ctl, $arg, $key) if okay,
+ # returns (1, undef) if option in error,
+ # returns (0) otherwise.
-$find_option = sub {
+ my ($prefix, $argend, $opt, $opctl) = @_;
- print STDERR ("=> find \"$opt\", genprefix=\"$genprefix\"\n") if $debug;
+ print STDERR ("=> find \"$opt\"\n") if $debug;
- return 0 unless $opt =~ /^$genprefix(.*)$/s;
+ return (0) unless $opt =~ /^$prefix(.*)$/s;
+ return (0) if $opt eq "-" && !defined $opctl->{''};
$opt = $+;
- my ($starter) = $1;
+ my $starter = $1;
print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
- my $optarg = undef; # value supplied with --opt=value
- my $rest = undef; # remainder from unbundling
+ my $optarg; # value supplied with --opt=value
+ my $rest; # remainder from unbundling
# If it is a long option, it may include the value.
- if (($starter eq "--" || ($getopt_compat && !$bundling))
- && $opt =~ /^([^=]+)=(.*)$/s ) {
+ # With getopt_compat, only if not bundling.
+ if ( ($starter eq "--"
+ || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
+ && $opt =~ /^([^=]+)=(.*)$/s ) {
$opt = $1;
$optarg = $2;
- print STDERR ("=> option \"", $opt,
+ print STDERR ("=> option \"", $opt,
"\", optarg = \"$optarg\"\n") if $debug;
}
#### Look it up ###
my $tryopt = $opt; # option to try
- my $optbl = \%opctl; # table to look it up (long names)
- my $type;
if ( $bundling && $starter eq '-' ) {
- # Unbundle single letter option.
- $rest = substr ($tryopt, 1);
- $tryopt = substr ($tryopt, 0, 1);
- $tryopt = lc ($tryopt) if $ignorecase > 1;
- print STDERR ("=> $starter$tryopt unbundled from ",
- "$starter$tryopt$rest\n") if $debug;
- $rest = undef unless $rest ne '';
- $optbl = \%bopctl; # look it up in the short names table
+
+ # To try overrides, obey case ignore.
+ $tryopt = $ignorecase ? lc($opt) : $opt;
# If bundling == 2, long options can override bundles.
- if ( $bundling == 2 and
- defined ($type = $opctl{$tryopt.$rest}) ) {
- print STDERR ("=> $starter$tryopt rebundled to ",
+ if ( $bundling == 2 && length($tryopt) > 1
+ && defined ($opctl->{$tryopt}) ) {
+ print STDERR ("=> $starter$tryopt overrides unbundling\n")
+ if $debug;
+ }
+ else {
+ $tryopt = $opt;
+ # Unbundle single letter option.
+ $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
+ $tryopt = substr ($tryopt, 0, 1);
+ $tryopt = lc ($tryopt) if $ignorecase > 1;
+ print STDERR ("=> $starter$tryopt unbundled from ",
"$starter$tryopt$rest\n") if $debug;
- $tryopt .= $rest;
- undef $rest;
+ $rest = undef unless $rest ne '';
}
- }
+ }
# Try auto-abbreviation.
elsif ( $autoabbrev ) {
+ # Sort the possible long option names.
+ my @names = sort(keys (%$opctl));
# Downcase if allowed.
- $tryopt = $opt = lc ($opt) if $ignorecase;
+ $opt = lc ($opt) if $ignorecase;
+ $tryopt = $opt;
# Turn option name into pattern.
my $pat = quotemeta ($opt);
# Look up in option names.
- my @hits = grep (/^$pat/, @opctl);
+ my @hits = grep (/^$pat/, @names);
print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
- "out of ", scalar(@opctl), "\n") if $debug;
+ "out of ", scalar(@names), "\n") if $debug;
# Check for ambiguous results.
unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
# See if all matches are for the same option.
my %hit;
foreach ( @hits ) {
- $_ = $aliases{$_} if defined $aliases{$_};
+ $_ = $opctl->{$_}->[CTL_CNAME]
+ if defined $opctl->{$_}->[CTL_CNAME];
$hit{$_} = 1;
}
+ # Remove auto-supplied options (version, help).
+ if ( keys(%hit) == 2 ) {
+ if ( $auto_version && exists($hit{version}) ) {
+ delete $hit{version};
+ }
+ elsif ( $auto_help && exists($hit{help}) ) {
+ delete $hit{help};
+ }
+ }
# Now see if it really is ambiguous.
unless ( keys(%hit) == 1 ) {
- return 0 if $passthrough;
+ return (0) if $passthrough;
warn ("Option ", $opt, " is ambiguous (",
join(", ", @hits), ")\n");
$error++;
- undef $opt;
- return 1;
+ return (1, undef);
}
@hits = keys(%hit);
}
}
# Check validity by fetching the info.
- $type = $optbl->{$tryopt} unless defined $type;
- unless ( defined $type ) {
- return 0 if $passthrough;
+ my $ctl = $opctl->{$tryopt};
+ unless ( defined $ctl ) {
+ return (0) if $passthrough;
+ # Pretend one char when bundling.
+ if ( $bundling == 1) {
+ $opt = substr($opt,0,1);
+ unshift (@ARGV, $starter.$rest) if defined $rest;
+ }
warn ("Unknown option: ", $opt, "\n");
$error++;
- return 1;
+ return (1, undef);
}
# Apparently valid.
$opt = $tryopt;
- print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+ print STDERR ("=> found ", OptCtl($ctl),
+ " for \"", $opt, "\"\n") if $debug;
#### Determine argument status ####
# If it is an option w/o argument, we're almost finished with it.
- if ( $type eq '' || $type eq '!' ) {
+ my $type = $ctl->[CTL_TYPE];
+ my $arg;
+
+ if ( $type eq '' || $type eq '!' || $type eq '+' ) {
if ( defined $optarg ) {
- return 0 if $passthrough;
+ return (0) if $passthrough;
warn ("Option ", $opt, " does not take an argument\n");
$error++;
undef $opt;
}
- elsif ( $type eq '' ) {
- $arg = 1; # supply explicit value
+ elsif ( $type eq '' || $type eq '+' ) {
+ # Supply explicit value.
+ $arg = 1;
}
else {
- substr ($opt, 0, 2) = ''; # strip NO prefix
+ $opt =~ s/^no-?//i; # strip NO prefix
$arg = 0; # supply explicit value
}
unshift (@ARGV, $starter.$rest) if defined $rest;
- return 1;
+ return (1, $opt, $ctl, $arg);
}
# Get mandatory status and type info.
- my $mand;
- ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+ my $mand = $ctl->[CTL_AMIN];
+
+ # Check if there is an option argument available.
+ if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
+ return (1, $opt, $ctl, $type eq 's' ? '' : 0) unless $mand;
+ $optarg = 0 unless $type eq 's';
+ }
# Check if there is an option argument available.
- if ( defined $optarg ? ($optarg eq '')
+ if ( defined $optarg
+ ? ($optarg eq '')
: !(defined $rest || @ARGV > 0) ) {
# Complain if this option needs an argument.
- if ( $mand eq "=" ) {
- return 0 if $passthrough;
+ if ( $mand ) {
+ return (0) if $passthrough;
warn ("Option ", $opt, " requires an argument\n");
$error++;
- undef $opt;
+ return (1, undef);
}
- if ( $mand eq ":" ) {
- $arg = $type eq "s" ? '' : 0;
+ if ( $type eq 'I' ) {
+ # Fake incremental type.
+ my @c = @$ctl;
+ $c[CTL_TYPE] = '+';
+ return (1, $opt, \@c, 1);
}
- return 1;
+ return (1, $opt, $ctl,
+ defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
+ $type eq 's' ? '' : 0);
}
# Get (possibly optional) argument.
: (defined $optarg ? $optarg : shift (@ARGV)));
# Get key if this is a "name=value" pair for a hash option.
- $key = undef;
- if ($hash && defined $arg) {
- ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
+ my $key;
+ if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
+ ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
+ : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
+ ($mand ? undef : ($type eq 's' ? "" : 1)));
+ if (! defined $arg) {
+ warn ("Option $opt, key \"$key\", requires a value\n");
+ $error++;
+ # Push back.
+ unshift (@ARGV, $starter.$rest) if defined $rest;
+ return (1, undef);
+ }
}
#### Check if the argument is valid for this option ####
- if ( $type eq "s" ) { # string
- # A mandatory string takes anything.
- return 1 if $mand eq "=";
+ my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
+
+ if ( $type eq 's' ) { # string
+ # A mandatory string takes anything.
+ return (1, $opt, $ctl, $arg, $key) if $mand;
- # An optional string takes almost anything.
- return 1 if defined $optarg || defined $rest;
- return 1 if $arg eq "-"; # ??
+ # An optional string takes almost anything.
+ return (1, $opt, $ctl, $arg, $key)
+ if defined $optarg || defined $rest;
+ return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
# Check for option or option list terminator.
if ($arg eq $argend ||
- $arg =~ /^$genprefix.+/) {
+ $arg =~ /^$prefix.+/) {
# Push back.
unshift (@ARGV, $arg);
# Supply empty value.
}
}
- elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
- if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
- $arg = $1;
- $rest = $2;
+ elsif ( $type eq 'i' # numeric/integer
+ || $type eq 'I' # numeric/integer w/ incr default
+ || $type eq 'o' ) { # dec/oct/hex/bin value
+
+ my $o_valid =
+ $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
+ : "[-+]?[0-9]+";
+
+ if ( $bundling && defined $rest
+ && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
+ ($key, $arg, $rest) = ($1, $2, $+);
+ chop($key) if $key;
+ $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
}
- elsif ( $arg !~ /^-?[0-9]+$/ ) {
- if ( defined $optarg || $mand eq "=" ) {
+ elsif ( $arg =~ /^($o_valid)$/si ) {
+ $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
+ }
+ else {
+ if ( defined $optarg || $mand ) {
if ( $passthrough ) {
unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
unless defined $optarg;
- return 0;
+ return (0);
}
warn ("Value \"", $arg, "\" invalid for option ",
- $opt, " (number expected)\n");
+ $opt, " (",
+ $type eq 'o' ? "extended " : '',
+ "number expected)\n");
$error++;
- undef $opt;
# Push back.
unshift (@ARGV, $starter.$rest) if defined $rest;
+ return (1, undef);
}
else {
# Push back.
unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+ if ( $type eq 'I' ) {
+ # Fake incremental type.
+ my @c = @$ctl;
+ $c[CTL_TYPE] = '+';
+ return (1, $opt, \@c, 1);
+ }
# Supply default value.
- $arg = 0;
+ $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
}
}
}
- elsif ( $type eq "f" ) { # real number, int is also ok
+ elsif ( $type eq 'f' ) { # real number, int is also ok
# We require at least one digit before a point or 'e',
# and at least one digit following the point and 'e'.
# [-]NN[.NN][eNN]
if ( $bundling && defined $rest &&
- $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
- $arg = $1;
- $rest = $+;
+ $rest =~ /^($key_valid)([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
+ ($key, $arg, $rest) = ($1, $2, $+);
+ chop($key) if $key;
unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
}
- elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
- if ( defined $optarg || $mand eq "=" ) {
+ elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
+ if ( defined $optarg || $mand ) {
if ( $passthrough ) {
unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
unless defined $optarg;
- return 0;
+ return (0);
}
warn ("Value \"", $arg, "\" invalid for option ",
$opt, " (real number expected)\n");
$error++;
- undef $opt;
# Push back.
unshift (@ARGV, $starter.$rest) if defined $rest;
+ return (1, undef);
}
else {
# Push back.
}
}
else {
- &$croak ("GetOpt::Long internal error (Can't happen)\n");
+ die("Getopt::Long internal error (Can't happen)\n");
}
- return 1;
-};
+ return (1, $opt, $ctl, $arg, $key);
+}
-$config_defaults = sub {
- # Handle POSIX compliancy.
- if ( defined $ENV{"POSIXLY_CORRECT"} ) {
- $gen_prefix = "(--|-)";
- $autoabbrev = 0; # no automatic abbrev of options
- $bundling = 0; # no bundling of single letter switches
- $getopt_compat = 0; # disallow '+' to start options
- $order = $REQUIRE_ORDER;
- }
- else {
- $gen_prefix = "(--|-|\\+)";
- $autoabbrev = 1; # automatic abbrev of options
- $bundling = 0; # bundling off by default
- $getopt_compat = 1; # allow '+' to start options
- $order = $PERMUTE;
+sub ValidValue ($$$$$) {
+ my ($ctl, $arg, $mand, $argend, $prefix) = @_;
+
+ if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+ return 0 unless $arg =~ /[^=]+=(.*)/;
+ $arg = $1;
}
- # Other configurable settings.
- $debug = 0; # for debugging
- $error = 0; # error tally
- $ignorecase = 1; # ignore case when matching options
- $passthrough = 0; # leave unrecognized options alone
-};
-################ Initialization ################
+ my $type = $ctl->[CTL_TYPE];
-# Values for $order. See GNU getopt.c for details.
-($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
-# Version major/minor numbers.
-($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+ if ( $type eq 's' ) { # string
+ # A mandatory string takes anything.
+ return (1) if $mand;
-# Set defaults.
-&$config_defaults ();
+ return (1) if $arg eq "-";
-################ Package return ################
+ # Check for option or option list terminator.
+ return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
+ return 1;
+ }
-1;
+ elsif ( $type eq 'i' # numeric/integer
+ || $type eq 'I' # numeric/integer w/ incr default
+ || $type eq 'o' ) { # dec/oct/hex/bin value
-__END__
+ my $o_valid =
+ $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
+ : "[-+]?[0-9]+";
-=head1 NAME
+ return $arg =~ /^$o_valid$/si;
+ }
-GetOptions - extended processing of command line options
+ elsif ( $type eq 'f' ) { # real number, int is also ok
+ # We require at least one digit before a point or 'e',
+ # and at least one digit following the point and 'e'.
+ # [-]NN[.NN][eNN]
+ return $arg =~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/;
+ }
+ die("ValidValue: Cannot happen\n");
+}
-=head1 SYNOPSIS
+# Getopt::Long Configuration.
+sub Configure (@) {
+ my (@options) = @_;
- use Getopt::Long;
- $result = GetOptions (...option-descriptions...);
+ my $prevconfig =
+ [ $error, $debug, $major_version, $minor_version,
+ $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
+ $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ];
-=head1 DESCRIPTION
+ if ( ref($options[0]) eq 'ARRAY' ) {
+ ( $error, $debug, $major_version, $minor_version,
+ $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
+ $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help ) =
+ @{shift(@options)};
+ }
-The Getopt::Long module implements an extended getopt function called
+ my $opt;
+ foreach $opt ( @options ) {
+ my $try = lc ($opt);
+ my $action = 1;
+ if ( $try =~ /^no_?(.*)$/s ) {
+ $action = 0;
+ $try = $+;
+ }
+ if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
+ ConfigDefaults ();
+ }
+ elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
+ local $ENV{POSIXLY_CORRECT};
+ $ENV{POSIXLY_CORRECT} = 1 if $action;
+ ConfigDefaults ();
+ }
+ elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+ $autoabbrev = $action;
+ }
+ elsif ( $try eq 'getopt_compat' ) {
+ $getopt_compat = $action;
+ }
+ elsif ( $try eq 'gnu_getopt' ) {
+ if ( $action ) {
+ $gnu_compat = 1;
+ $bundling = 1;
+ $getopt_compat = 0;
+ $order = $PERMUTE;
+ }
+ }
+ elsif ( $try eq 'gnu_compat' ) {
+ $gnu_compat = $action;
+ }
+ elsif ( $try =~ /^(auto_?)?version$/ ) {
+ $auto_version = $action;
+ }
+ elsif ( $try =~ /^(auto_?)?help$/ ) {
+ $auto_help = $action;
+ }
+ elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+ $ignorecase = $action;
+ }
+ elsif ( $try eq 'ignore_case_always' ) {
+ $ignorecase = $action ? 2 : 0;
+ }
+ elsif ( $try eq 'bundling' ) {
+ $bundling = $action;
+ }
+ elsif ( $try eq 'bundling_override' ) {
+ $bundling = $action ? 2 : 0;
+ }
+ elsif ( $try eq 'require_order' ) {
+ $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+ }
+ elsif ( $try eq 'permute' ) {
+ $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+ }
+ elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+ $passthrough = $action;
+ }
+ elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
+ $genprefix = $1;
+ # Turn into regexp. Needs to be parenthesized!
+ $genprefix = "(" . quotemeta($genprefix) . ")";
+ eval { '' =~ /$genprefix/; };
+ die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+ }
+ elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
+ $genprefix = $1;
+ # Parenthesize if needed.
+ $genprefix = "(" . $genprefix . ")"
+ unless $genprefix =~ /^\(.*\)$/;
+ eval { '' =~ /$genprefix/; };
+ die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+ }
+ elsif ( $try eq 'debug' ) {
+ $debug = $action;
+ }
+ else {
+ die("Getopt::Long: unknown config parameter \"$opt\"")
+ }
+ }
+ $prevconfig;
+}
+
+# Deprecated name.
+sub config (@) {
+ Configure (@_);
+}
+
+# Issue a standard message for --version.
+#
+# The arguments are mostly the same as for Pod::Usage::pod2usage:
+#
+# - a number (exit value)
+# - a string (lead in message)
+# - a hash with options. See Pod::Usage for details.
+#
+sub VersionMessage(@) {
+ # Massage args.
+ my $pa = setup_pa_args("version", @_);
+
+ my $v = $main::VERSION;
+ my $fh = $pa->{-output} ||
+ ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
+
+ print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
+ $0, defined $v ? " version $v" : (),
+ "\n",
+ "(", __PACKAGE__, "::", "GetOptions",
+ " version ",
+ defined($Getopt::Long::VERSION_STRING)
+ ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
+ " Perl version ",
+ $] >= 5.006 ? sprintf("%vd", $^V) : $],
+ ")\n");
+ exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
+}
+
+# Issue a standard message for --help.
+#
+# The arguments are the same as for Pod::Usage::pod2usage:
+#
+# - a number (exit value)
+# - a string (lead in message)
+# - a hash with options. See Pod::Usage for details.
+#
+sub HelpMessage(@) {
+ eval {
+ require Pod::Usage;
+ import Pod::Usage;
+ 1;
+ } || die("Cannot provide help: cannot load Pod::Usage\n");
+
+ # Note that pod2usage will issue a warning if -exitval => NOEXIT.
+ pod2usage(setup_pa_args("help", @_));
+
+}
+
+# Helper routine to set up a normalized hash ref to be used as
+# argument to pod2usage.
+sub setup_pa_args($@) {
+ my $tag = shift; # who's calling
+
+ # If called by direct binding to an option, it will get the option
+ # name and value as arguments. Remove these, if so.
+ @_ = () if @_ == 2 && $_[0] eq $tag;
+
+ my $pa;
+ if ( @_ > 1 ) {
+ $pa = { @_ };
+ }
+ else {
+ $pa = shift || {};
+ }
+
+ # At this point, $pa can be a number (exit value), string
+ # (message) or hash with options.
+
+ if ( UNIVERSAL::isa($pa, 'HASH') ) {
+ # Get rid of -msg vs. -message ambiguity.
+ $pa->{-message} = $pa->{-msg};
+ delete($pa->{-msg});
+ }
+ elsif ( $pa =~ /^-?\d+$/ ) {
+ $pa = { -exitval => $pa };
+ }
+ else {
+ $pa = { -message => $pa };
+ }
+
+ # These are _our_ defaults.
+ $pa->{-verbose} = 0 unless exists($pa->{-verbose});
+ $pa->{-exitval} = 0 unless exists($pa->{-exitval});
+ $pa;
+}
+
+# Sneak way to know what version the user requested.
+sub VERSION {
+ $requested_version = $_[1];
+ shift->SUPER::VERSION(@_);
+}
+
+1;
+
+################ Documentation ################
+
+=head1 NAME
+
+Getopt::Long - Extended processing of command line options
+
+=head1 SYNOPSIS
+
+ use Getopt::Long;
+ my $data = "file.dat";
+ my $length = 24;
+ my $verbose;
+ $result = GetOptions ("length=i" => \$length, # numeric
+ "file=s" => \$data, # string
+ "verbose" => \$verbose); # flag
+
+=head1 DESCRIPTION
+
+The Getopt::Long module implements an extended getopt function called
GetOptions(). This function adheres to the POSIX syntax for command
line options, with GNU extensions. In general, this means that options
have long names instead of single letters, and are introduced with a
double dash "--". Support for bundling of command line options, as was
the case with the more traditional single-letter approach, is provided
-but not enabled by default. For example, the UNIX "ps" command can be
-given the command line "option"
+but not enabled by default.
+
+=head1 Command Line Options, an Introduction
+
+Command line operated programs traditionally take their arguments from
+the command line, for example filenames or other information that the
+program needs to know. Besides arguments, these programs often take
+command line I<options> as well. Options are not necessary for the
+program to work, hence the name 'option', but are used to modify its
+default behaviour. For example, a program could do its job quietly,
+but with a suitable option it could provide verbose information about
+what it did.
+
+Command line options come in several flavours. Historically, they are
+preceded by a single dash C<->, and consist of a single letter.
+
+ -l -a -c
+
+Usually, these single-character options can be bundled:
+
+ -lac
+
+Options can have values, the value is placed after the option
+character. Sometimes with whitespace in between, sometimes not:
+
+ -s 24 -s24
+
+Due to the very cryptic nature of these options, another style was
+developed that used long names. So instead of a cryptic C<-l> one
+could use the more descriptive C<--long>. To distinguish between a
+bundle of single-character options and a long one, two dashes are used
+to precede the option name. Early implementations of long options used
+a plus C<+> instead. Also, option values could be specified either
+like
+
+ --size=24
+
+or
+
+ --size 24
+
+The C<+> form is now obsolete and strongly deprecated.
+
+=head1 Getting Started with Getopt::Long
+
+Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
+the first Perl module that provided support for handling the new style
+of command line options, hence the name Getopt::Long. This module
+also supports single-character options and bundling. In this case, the
+options are restricted to alphabetic characters only, and the
+characters C<?> and C<->.
+
+To use Getopt::Long from a Perl program, you must include the
+following line in your Perl program:
+
+ use Getopt::Long;
+
+This will load the core of the Getopt::Long module and prepare your
+program for using it. Most of the actual Getopt::Long code is not
+loaded until you really call one of its functions.
+
+In the default configuration, options names may be abbreviated to
+uniqueness, case does not matter, and a single dash is sufficient,
+even for long option names. Also, options may be placed between
+non-option arguments. See L<Configuring Getopt::Long> for more
+details on how to configure Getopt::Long.
+
+=head2 Simple options
+
+The most simple options are the ones that take no values. Their mere
+presence on the command line enables the option. Popular examples are:
+
+ --all --verbose --quiet --debug
+
+Handling simple options is straightforward:
+
+ my $verbose = ''; # option variable with default value (false)
+ my $all = ''; # option variable with default value (false)
+ GetOptions ('verbose' => \$verbose, 'all' => \$all);
+
+The call to GetOptions() parses the command line arguments that are
+present in C<@ARGV> and sets the option variable to the value C<1> if
+the option did occur on the command line. Otherwise, the option
+variable is not touched. Setting the option value to true is often
+called I<enabling> the option.
+
+The option name as specified to the GetOptions() function is called
+the option I<specification>. Later we'll see that this specification
+can contain more than just the option name. The reference to the
+variable is called the option I<destination>.
+
+GetOptions() will return a true value if the command line could be
+processed successfully. Otherwise, it will write error messages to
+STDERR, and return a false result.
+
+=head2 A little bit less simple options
+
+Getopt::Long supports two useful variants of simple options:
+I<negatable> options and I<incremental> options.
+
+A negatable option is specified with an exclamation mark C<!> after the
+option name:
+
+ my $verbose = ''; # option variable with default value (false)
+ GetOptions ('verbose!' => \$verbose);
+
+Now, using C<--verbose> on the command line will enable C<$verbose>,
+as expected. But it is also allowed to use C<--noverbose>, which will
+disable C<$verbose> by setting its value to C<0>. Using a suitable
+default value, the program can find out whether C<$verbose> is false
+by default, or disabled by using C<--noverbose>.
+
+An incremental option is specified with a plus C<+> after the
+option name:
+
+ my $verbose = ''; # option variable with default value (false)
+ GetOptions ('verbose+' => \$verbose);
+
+Using C<--verbose> on the command line will increment the value of
+C<$verbose>. This way the program can keep track of how many times the
+option occurred on the command line. For example, each occurrence of
+C<--verbose> could increase the verbosity level of the program.
+
+=head2 Mixing command line option with other arguments
+
+Usually programs take command line options as well as other arguments,
+for example, file names. It is good practice to always specify the
+options first, and the other arguments last. Getopt::Long will,
+however, allow the options and arguments to be mixed and 'filter out'
+all the options before passing the rest of the arguments to the
+program. To stop Getopt::Long from processing further arguments,
+insert a double dash C<--> on the command line:
+
+ --size 24 -- --all
+
+In this example, C<--all> will I<not> be treated as an option, but
+passed to the program unharmed, in C<@ARGV>.
+
+=head2 Options with values
+
+For options that take values it must be specified whether the option
+value is required or not, and what kind of value the option expects.
+
+Three kinds of values are supported: integer numbers, floating point
+numbers, and strings.
+
+If the option value is required, Getopt::Long will take the
+command line argument that follows the option and assign this to the
+option variable. If, however, the option value is specified as
+optional, this will only be done if that value does not look like a
+valid command line option itself.
+
+ my $tag = ''; # option variable with default value
+ GetOptions ('tag=s' => \$tag);
+
+In the option specification, the option name is followed by an equals
+sign C<=> and the letter C<s>. The equals sign indicates that this
+option requires a value. The letter C<s> indicates that this value is
+an arbitrary string. Other possible value types are C<i> for integer
+values, and C<f> for floating point values. Using a colon C<:> instead
+of the equals sign indicates that the option value is optional. In
+this case, if no suitable value is supplied, string valued options get
+an empty string C<''> assigned, while numeric options are set to C<0>.
+
+=head2 Options with multiple values
+
+Options sometimes take several values. For example, a program could
+use multiple directories to search for library files:
+
+ --library lib/stdlib --library lib/extlib
+
+To accomplish this behaviour, simply specify an array reference as the
+destination for the option:
+
+ GetOptions ("library=s" => \@libfiles);
+
+Alternatively, you can specify that the option can have multiple
+values by adding a "@", and pass a scalar reference as the
+destination:
+
+ GetOptions ("library=s@" => \$libfiles);
+
+Used with the example above, C<@libfiles> (or C<@$libfiles>) would
+contain two strings upon completion: C<"lib/srdlib"> and
+C<"lib/extlib">, in that order. It is also possible to specify that
+only integer or floating point numbers are acceptible values.
+
+Often it is useful to allow comma-separated lists of values as well as
+multiple occurrences of the options. This is easy using Perl's split()
+and join() operators:
+
+ GetOptions ("library=s" => \@libfiles);
+ @libfiles = split(/,/,join(',',@libfiles));
+
+Of course, it is important to choose the right separator string for
+each purpose.
+
+Warning: What follows is an experimental feature.
+
+Options can take multiple values at once, for example
- -vax
+ --coordinates 52.2 16.4 --rgbcolor 255 255 149
-which means the combination of B<-v>, B<-a> and B<-x>. With the new
-syntax B<--vax> would be a single option, probably indicating a
-computer architecture.
+This can be accomplished by adding a repeat specifier to the option
+specification. Repeat specifiers are very similar to the C<{...}>
+repeat specifiers that can be used with regular expression patterns.
+For example, the above command line would be handled as follows:
-Command line options can be used to set values. These values can be
-specified in one of two ways:
+ GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
- --size 24
- --size=24
+The destination for the option must be an array or array reference.
-GetOptions is called with a list of option-descriptions, each of which
-consists of two elements: the option specifier and the option linkage.
-The option specifier defines the name of the option and, optionally,
-the value it can take. The option linkage is usually a reference to a
-variable that will be set when the option is used. For example, the
-following call to GetOptions:
+It is also possible to specify the minimal and maximal number of
+arguments an option takes. C<foo=s{2,4}> indicates an option that
+takes at least two and at most 4 arguments. C<foo=s{,}> indicates one
+or more values; C<foo:s{,}> indicates zero or more option values.
- GetOptions("size=i" => \$offset);
+=head2 Options with hash values
-will accept a command line option "size" that must have an integer
-value. With a command line of "--size 24" this will cause the variable
-$offset to get the value 24.
+If the option destination is a reference to a hash, the option will
+take, as value, strings of the form I<key>C<=>I<value>. The value will
+be stored with the specified key in the hash.
-Alternatively, the first argument to GetOptions may be a reference to
-a HASH describing the linkage for the options, or an object whose
-class is based on a HASH. The following call is equivalent to the
-example above:
+ GetOptions ("define=s" => \%defines);
- %optctl = ("size" => \$offset);
- GetOptions(\%optctl, "size=i");
+Alternatively you can use:
-Linkage may be specified using either of the above methods, or both.
-Linkage specified in the argument list takes precedence over the
-linkage specified in the HASH.
+ GetOptions ("define=s%" => \$defines);
-The command line options are taken from array @ARGV. Upon completion
-of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
-the command line.
-
-Each option specifier designates the name of the option, optionally
-followed by an argument specifier.
+When used with command line options:
-Options that do not take arguments will have no argument specifier.
-The option variable will be set to 1 if the option is used.
+ --define os=linux --define vendor=redhat
-For the other options, the values for argument specifiers are:
+the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
+with value C<"linux> and C<"vendor"> with value C<"redhat">. It is
+also possible to specify that only integer or floating point numbers
+are acceptible values. The keys are always taken to be strings.
-=over 8
+=head2 User-defined subroutines to handle options
+
+Ultimate control over what should be done when (actually: each time)
+an option is encountered on the command line can be achieved by
+designating a reference to a subroutine (or an anonymous subroutine)
+as the option destination. When GetOptions() encounters the option, it
+will call the subroutine with two or three arguments. The first
+argument is the name of the option. For a scalar or array destination,
+the second argument is the value to be stored. For a hash destination,
+the second arguments is the key to the hash, and the third argument
+the value to be stored. It is up to the subroutine to store the value,
+or do whatever it thinks is appropriate.
+
+A trivial application of this mechanism is to implement options that
+are related to each other. For example:
+
+ my $verbose = ''; # option variable with default value (false)
+ GetOptions ('verbose' => \$verbose,
+ 'quiet' => sub { $verbose = 0 });
+
+Here C<--verbose> and C<--quiet> control the same variable
+C<$verbose>, but with opposite values.
+
+If the subroutine needs to signal an error, it should call die() with
+the desired error message as its argument. GetOptions() will catch the
+die(), issue the error message, and record that an error result must
+be returned upon completion.
+
+If the text of the error message starts with an exclamantion mark C<!>
+it is interpreted specially by GetOptions(). There is currently one
+special command implemented: C<die("!FINISH")> will cause GetOptions()
+to stop processing options, as if it encountered a double dash C<-->.
+
+=head2 Options with multiple names
+
+Often it is user friendly to supply alternate mnemonic names for
+options. For example C<--height> could be an alternate name for
+C<--length>. Alternate names can be included in the option
+specification, separated by vertical bar C<|> characters. To implement
+the above example:
+
+ GetOptions ('length|height=f' => \$length);
+
+The first name is called the I<primary> name, the other names are
+called I<aliases>.
+
+Multiple alternate names are possible.
+
+=head2 Case and abbreviations
+
+Without additional configuration, GetOptions() will ignore the case of
+option names, and allow the options to be abbreviated to uniqueness.
+
+ GetOptions ('length|height=f' => \$length, "head" => \$head);
+
+This call will allow C<--l> and C<--L> for the length option, but
+requires a least C<--hea> and C<--hei> for the head and height options.
+
+=head2 Summary of Option Specifications
+
+Each option specifier consists of two parts: the name specification
+and the argument specification.
+
+The name specification contains the name of the option, optionally
+followed by a list of alternative names separated by vertical bar
+characters.
+
+ length option name is "length"
+ length|size|l name is "length", aliases are "size" and "l"
+
+The argument specification is optional. If omitted, the option is
+considered boolean, a value of 1 will be assigned when the option is
+used on the command line.
+
+The argument specification can be
+
+=over 4
=item !
-Option does not take an argument and may be negated, i.e. prefixed by
-"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
-(with value 0).
-The option variable will be set to 1, or 0 if negated.
+The option does not take an argument and may be negated, i.e. prefixed
+by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
+assigned) and C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the
+option has aliases, this applies to the aliases as well.
+
+Using negation on a single letter option when bundling is in effect is
+pointless and will result in a warning.
+
+=item +
-=item =s
+The option does not take an argument and will be incremented by 1
+every time it appears on the command line. E.g. C<"more+">, when used
+with C<--more --more --more>, will increment the value three times,
+resulting in a value of 3 (provided it was 0 or undefined at first).
-Option takes a mandatory string argument.
-This string will be assigned to the option variable.
-Note that even if the string argument starts with B<-> or B<-->, it
-will not be considered an option on itself.
+The C<+> specifier is ignored if the option destination is not a scalar.
-=item :s
+=item = I<type> [ I<desttype> ] [ I<repeat> ]
-Option takes an optional string argument.
-This string will be assigned to the option variable.
-If omitted, it will be assigned "" (an empty string).
-If the string argument starts with B<-> or B<-->, it
-will be considered an option on itself.
+The option requires an argument of the given type. Supported types
+are:
-=item =i
+=over 4
-Option takes a mandatory integer argument.
-This value will be assigned to the option variable.
-Note that the value may start with B<-> to indicate a negative
-value.
+=item s
-=item :i
+String. An arbitrary sequence of characters. It is valid for the
+argument to start with C<-> or C<-->.
-Option takes an optional integer argument.
-This value will be assigned to the option variable.
-If omitted, the value 0 will be assigned.
-Note that the value may start with B<-> to indicate a negative
-value.
+=item i
-=item =f
+Integer. An optional leading plus or minus sign, followed by a
+sequence of digits.
-Option takes a mandatory real number argument.
-This value will be assigned to the option variable.
-Note that the value may start with B<-> to indicate a negative
-value.
+=item o
-=item :f
+Extended integer, Perl style. This can be either an optional leading
+plus or minus sign, followed by a sequence of digits, or an octal
+string (a zero, optionally followed by '0', '1', .. '7'), or a
+hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
+insensitive), or a binary string (C<0b> followed by a series of '0'
+and '1').
-Option takes an optional real number argument.
-This value will be assigned to the option variable.
-If omitted, the value 0 will be assigned.
+=item f
+
+Real number. For example C<3.14>, C<-6.23E24> and so on.
=back
-A lone dash B<-> is considered an option, the corresponding option
-name is the empty string.
+The I<desttype> can be C<@> or C<%> to specify that the option is
+list or a hash valued. This is only needed when the destination for
+the option value is not otherwise specified. It should be omitted when
+not needed.
-A double dash on itself B<--> signals end of the options list.
+The I<repeat> specifies the number of values this option takes per
+occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
-=head2 Linkage specification
+I<min> denotes the minimal number of arguments. It defaults to 1 for
+options with C<=> and to 0 for options with C<:>, see below. Note that
+I<min> overrules the C<=> / C<:> semantics.
-The linkage specifier is optional. If no linkage is explicitly
-specified but a ref HASH is passed, GetOptions will place the value in
-the HASH. For example:
+I<max> denotes the maximum number of arguments. It must be at least
+I<min>. If I<max> is omitted, I<but the comma is not>, there is no
+upper bound to the number of argument values taken.
- %optctl = ();
- GetOptions (\%optctl, "size=i");
+=item : I<type> [ I<desttype> ]
-will perform the equivalent of the assignment
+Like C<=>, but designates the argument as optional.
+If omitted, an empty string will be assigned to string values options,
+and the value zero to numeric options.
- $optctl{"size"} = 24;
+Note that if a string argument starts with C<-> or C<-->, it will be
+considered an option on itself.
-For array options, a reference to an array is used, e.g.:
+=item : I<number> [ I<desttype> ]
- %optctl = ();
- GetOptions (\%optctl, "sizes=i@");
+Like C<:i>, but if the value is omitted, the I<number> will be assigned.
-with command line "-sizes 24 -sizes 48" will perform the equivalent of
-the assignment
+=item : + [ I<desttype> ]
- $optctl{"sizes"} = [24, 48];
+Like C<:i>, but if the value is omitted, the current value for the
+option will be incremented.
-For hash options (an option whose argument looks like "name=value"),
-a reference to a hash is used, e.g.:
+=back
- %optctl = ();
- GetOptions (\%optctl, "define=s%");
+=head1 Advanced Possibilities
-with command line "--define foo=hello --define bar=world" will perform the
-equivalent of the assignment
+=head2 Object oriented interface
- $optctl{"define"} = {foo=>'hello', bar=>'world')
+Getopt::Long can be used in an object oriented way as well:
-If no linkage is explicitly specified and no ref HASH is passed,
-GetOptions will put the value in a global variable named after the
-option, prefixed by "opt_". To yield a usable Perl variable,
-characters that are not part of the syntax for variables are
-translated to underscores. For example, "--fpp-struct-return" will set
-the variable $opt_fpp_struct_return. Note that this variable resides
-in the namespace of the calling program, not necessarily B<main>.
-For example:
+ use Getopt::Long;
+ $p = new Getopt::Long::Parser;
+ $p->configure(...configuration options...);
+ if ($p->getoptions(...options descriptions...)) ...
- GetOptions ("size=i", "sizes=i@");
+Configuration options can be passed to the constructor:
-with command line "-size 10 -sizes 24 -sizes 48" will perform the
-equivalent of the assignments
+ $p = new Getopt::Long::Parser
+ config => [...configuration options...];
- $opt_size = 10;
- @opt_sizes = (24, 48);
+=head2 Thread Safety
-A lone dash B<-> is considered an option, the corresponding Perl
-identifier is $opt_ .
+Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is
+I<not> thread safe when using the older (experimental and now
+obsolete) threads implementation that was added to Perl 5.005.
-The linkage specifier can be a reference to a scalar, a reference to
-an array, a reference to a hash or a reference to a subroutine.
+=head2 Documentation and help texts
-If a REF SCALAR is supplied, the new value is stored in the referenced
-variable. If the option occurs more than once, the previous value is
-overwritten.
+Getopt::Long encourages the use of Pod::Usage to produce help
+messages. For example:
-If a REF ARRAY is supplied, the new value is appended (pushed) to the
-referenced array.
+ use Getopt::Long;
+ use Pod::Usage;
-If a REF HASH is supplied, the option value should look like "key" or
-"key=value" (if the "=value" is omitted then a value of 1 is implied).
-In this case, the element of the referenced hash with the key "key"
-is assigned "value".
+ my $man = 0;
+ my $help = 0;
-If a REF CODE is supplied, the referenced subroutine is called with
-two arguments: the option name and the option value.
-The option name is always the true name, not an abbreviation or alias.
+ GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
+ pod2usage(1) if $help;
+ pod2usage(-exitstatus => 0, -verbose => 2) if $man;
-=head2 Aliases and abbreviations
+ __END__
-The option name may actually be a list of option names, separated by
-"|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
-of this option. If no linkage is specified, options "foo", "bar" and
-"blech" all will set $opt_foo. For convenience, the single character
-"?" is allowed as an alias, e.g. "help|?".
+ =head1 NAME
-Option names may be abbreviated to uniqueness, depending on
-configuration option B<auto_abbrev>.
+ sample - Using Getopt::Long and Pod::Usage
-=head2 Non-option call-back routine
+ =head1 SYNOPSIS
-A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
-to handle non-option arguments. GetOptions will immediately call this
-subroutine for every non-option it encounters in the options list.
-This subroutine gets the name of the non-option passed.
-This feature requires configuration option B<permute>, see section
-CONFIGURATION OPTIONS.
+ sample [options] [file ...]
-See also the examples.
+ Options:
+ -help brief help message
+ -man full documentation
-=head2 Option starters
+ =head1 OPTIONS
-On the command line, options can start with B<-> (traditional), B<-->
-(POSIX) and B<+> (GNU, now being phased out). The latter is not
-allowed if the environment variable B<POSIXLY_CORRECT> has been
-defined.
+ =over 8
-Options that start with "--" may have an argument appended, separated
-with an "=", e.g. "--foo=bar".
+ =item B<-help>
-=head2 Return values and Errors
+ Print a brief help message and exits.
-Configuration errors and errors in the option definitions are
-signalled using C<die()> and will terminate the calling
-program unless the call to C<Getopt::Long::GetOptions()> was embedded
-in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>.
+ =item B<-man>
-A return value of 1 (true) indicates success.
+ Prints the manual page and exits.
-A return status of 0 (false) indicates that the function detected one
-or more errors during option parsing. These errors are signalled using
-C<warn()> and can be trapped with C<$SIG{__WARN__}>.
+ =back
-Errors that can't happen are signalled using C<Carp::croak()>.
+ =head1 DESCRIPTION
-=head1 COMPATIBILITY
+ B<This program> will read the given input file(s) and do someting
+ useful with the contents thereof.
-Getopt::Long::GetOptions() is the successor of
-B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
-In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
-the module.
+ =cut
-If an "@" sign is appended to the argument specifier, the option is
-treated as an array. Value(s) are not set, but pushed into array
-@opt_name. If explicit linkage is supplied, this must be a reference
-to an ARRAY.
+See L<Pod::Usage> for details.
-If an "%" sign is appended to the argument specifier, the option is
-treated as a hash. Value(s) of the form "name=value" are set by
-setting the element of the hash %opt_name with key "name" to "value"
-(if the "=value" portion is omitted it defaults to 1). If explicit
-linkage is supplied, this must be a reference to a HASH.
+=head2 Storing options in a hash
-If configuration option B<getopt_compat> is set (see section
-CONFIGURATION OPTIONS), options that start with "+" or "-" may also
-include their arguments, e.g. "+foo=bar". This is for compatiblity
-with older implementations of the GNU "getopt" routine.
+Sometimes, for example when there are a lot of options, having a
+separate variable for each of them can be cumbersome. GetOptions()
+supports, as an alternative mechanism, storing options in a hash.
-If the first argument to GetOptions is a string consisting of only
-non-alphanumeric characters, it is taken to specify the option starter
-characters. Everything starting with one of these characters from the
-starter will be considered an option. B<Using a starter argument is
-strongly deprecated.>
+To obtain this, a reference to a hash must be passed I<as the first
+argument> to GetOptions(). For each option that is specified on the
+command line, the option value will be stored in the hash with the
+option name as key. Options that are not actually used on the command
+line will not be put in the hash, on other words,
+C<exists($h{option})> (or defined()) can be used to test if an option
+was used. The drawback is that warnings will be issued if the program
+runs under C<use strict> and uses C<$h{option}> without testing with
+exists() or defined() first.
-For convenience, option specifiers may have a leading B<-> or B<-->,
-so it is possible to write:
+ my %h = ();
+ GetOptions (\%h, 'length=i'); # will store in $h{length}
- GetOptions qw(-foo=s --bar=i --ar=s);
+For options that take list or hash values, it is necessary to indicate
+this by appending an C<@> or C<%> sign after the type:
-=head1 EXAMPLES
+ GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
-If the option specifier is "one:i" (i.e. takes an optional integer
-argument), then the following situations are handled:
+To make things more complicated, the hash may contain references to
+the actual destinations, for example:
- -one -two -> $opt_one = '', -two is next option
- -one -2 -> $opt_one = -2
+ my $len = 0;
+ my %h = ('length' => \$len);
+ GetOptions (\%h, 'length=i'); # will store in $len
-Also, assume specifiers "foo=s" and "bar:s" :
+This example is fully equivalent with:
- -bar -xxx -> $opt_bar = '', '-xxx' is next option
- -foo -bar -> $opt_foo = '-bar'
- -foo -- -> $opt_foo = '--'
+ my $len = 0;
+ GetOptions ('length=i' => \$len); # will store in $len
-In GNU or POSIX format, option names and values can be combined:
+Any mixture is possible. For example, the most frequently used options
+could be stored in variables while all other options get stored in the
+hash:
- +foo=blech -> $opt_foo = 'blech'
- --bar= -> $opt_bar = ''
- --bar=-- -> $opt_bar = '--'
+ my $verbose = 0; # frequently referred
+ my $debug = 0; # frequently referred
+ my %h = ('verbose' => \$verbose, 'debug' => \$debug);
+ GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
+ if ( $verbose ) { ... }
+ if ( exists $h{filter} ) { ... option 'filter' was specified ... }
-Example of using variable references:
+=head2 Bundling
- $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
+With bundling it is possible to set several single-character options
+at once. For example if C<a>, C<v> and C<x> are all valid options,
-With command line options "-foo blech -bar 24 -ar xx -ar yy"
-this will result in:
+ -vax
- $foo = 'blech'
- $opt_bar = 24
- @ar = ('xx','yy')
+would set all three.
-Example of using the E<lt>E<gt> option specifier:
+Getopt::Long supports two levels of bundling. To enable bundling, a
+call to Getopt::Long::Configure is required.
- @ARGV = qw(-foo 1 bar -foo 2 blech);
- GetOptions("foo=i", \$myfoo, "<>", \&mysub);
+The first level of bundling can be enabled with:
-Results:
+ Getopt::Long::Configure ("bundling");
- mysub("bar") will be called (with $myfoo being 1)
- mysub("blech") will be called (with $myfoo being 2)
+Configured this way, single-character options can be bundled but long
+options B<must> always start with a double dash C<--> to avoid
+abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
+options,
-Compare this with:
+ -vax
- @ARGV = qw(-foo 1 bar -foo 2 blech);
- GetOptions("foo=i", \$myfoo);
+would set C<a>, C<v> and C<x>, but
-This will leave the non-options in @ARGV:
+ --vax
- $myfoo -> 2
- @ARGV -> qw(bar blech)
+would set C<vax>.
-=head1 CONFIGURATION OPTIONS
+The second level of bundling lifts this restriction. It can be enabled
+with:
-B<GetOptions> can be configured by calling subroutine
-B<Getopt::Long::config>. This subroutine takes a list of quoted
-strings, each specifying a configuration option to be set, e.g.
-B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
-B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
-are possible.
+ Getopt::Long::Configure ("bundling_override");
-Previous versions of Getopt::Long used variables for the purpose of
-configuring. Although manipulating these variables still work, it
-is strongly encouraged to use the new B<config> routine. Besides, it
-is much easier.
+Now, C<-vax> would set the option C<vax>.
+
+When any level of bundling is enabled, option values may be inserted
+in the bundle. For example:
+
+ -h24w80
+
+is equivalent to
+
+ -h 24 -w 80
+
+When configured for bundling, single-character options are matched
+case sensitive while long options are matched case insensitive. To
+have the single-character options matched case insensitive as well,
+use:
+
+ Getopt::Long::Configure ("bundling", "ignorecase_always");
+
+It goes without saying that bundling can be quite confusing.
+
+=head2 The lonesome dash
+
+Normally, a lone dash C<-> on the command line will not be considered
+an option. Option processing will terminate (unless "permute" is
+configured) and the dash will be left in C<@ARGV>.
+
+It is possible to get special treatment for a lone dash. This can be
+achieved by adding an option specification with an empty name, for
+example:
+
+ GetOptions ('' => \$stdio);
+
+A lone dash on the command line will now be a legal option, and using
+it will set variable C<$stdio>.
+
+=head2 Argument callback
+
+A special option 'name' C<< <> >> can be used to designate a subroutine
+to handle non-option arguments. When GetOptions() encounters an
+argument that does not look like an option, it will immediately call this
+subroutine and passes it one parameter: the argument name.
+
+For example:
+
+ my $width = 80;
+ sub process { ... }
+ GetOptions ('width=i' => \$width, '<>' => \&process);
+
+When applied to the following command line:
+
+ arg1 --width=72 arg2 --width=60 arg3
+
+This will call
+C<process("arg1")> while C<$width> is C<80>,
+C<process("arg2")> while C<$width> is C<72>, and
+C<process("arg3")> while C<$width> is C<60>.
+
+This feature requires configuration option B<permute>, see section
+L<Configuring Getopt::Long>.
+
+=head1 Configuring Getopt::Long
+
+Getopt::Long can be configured by calling subroutine
+Getopt::Long::Configure(). This subroutine takes a list of quoted
+strings, each specifying a configuration option to be enabled, e.g.
+C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
+matter. Multiple calls to Configure() are possible.
+
+Alternatively, as of version 2.24, the configuration options may be
+passed together with the C<use> statement:
+
+ use Getopt::Long qw(:config no_ignore_case bundling);
The following options are available:
This option causes all configuration options to be reset to their
default values.
+=item posix_default
+
+This option causes all configuration options to be reset to their
+default values as if the environment variable POSIXLY_CORRECT had
+been set.
+
=item auto_abbrev
Allow option names to be abbreviated to uniqueness.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
+
+=item getopt_compat
+
+Allow C<+> to start options.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
+
+=item gnu_compat
-=item getopt_compat
+C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
+do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
+C<--opt=> will give option C<opt> and empty value.
+This is the way GNU getopt_long() does it.
-Allow '+' to start options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
+=item gnu_getopt
+
+This is a short way of setting C<gnu_compat> C<bundling> C<permute>
+C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
+fully compatible with GNU getopt_long().
=item require_order
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
+Whether command line arguments are allowed to be mixed with options.
+Default is disabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
-See also B<permute>, which is the opposite of B<require_order>.
+See also C<permute>, which is the opposite of C<require_order>.
=item permute
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<permute> is reset.
-Note that B<permute> is the opposite of B<require_order>.
+Whether command line arguments are allowed to be mixed with options.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
+Note that C<permute> is the opposite of C<require_order>.
-If B<permute> is set, this means that
+If C<permute> is enabled, this means that
- -foo arg1 -bar arg2 arg3
+ --foo arg1 --bar arg2 arg3
is equivalent to
- -foo -bar arg1 arg2 arg3
+ --foo --bar arg1 arg2 arg3
-If a non-option call-back routine is specified, @ARGV will always be
-empty upon succesful return of GetOptions since all options have been
-processed, except when B<--> is used:
+If an argument callback routine is specified, C<@ARGV> will always be
+empty upon succesful return of GetOptions() since all options have been
+processed. The only exception is when C<--> is used:
- -foo arg1 -bar arg2 -- arg3
+ --foo arg1 --bar arg2 -- arg3
-will call the call-back routine for arg1 and arg2, and terminate
-leaving arg2 in @ARGV.
+This will call the callback routine for arg1 and arg2, and then
+terminate GetOptions() leaving C<"arg2"> in C<@ARGV>.
-If B<require_order> is set, options processing
+If C<require_order> is enabled, options processing
terminates when the first non-option is encountered.
- -foo arg1 -bar arg2 arg3
+ --foo arg1 --bar arg2 arg3
is equivalent to
- -foo -- arg1 -bar arg2 arg3
+ --foo -- arg1 --bar arg2 arg3
-=item bundling (default: reset)
+If C<pass_through> is also enabled, options processing will terminate
+at the first unrecognized option, or non-option, whichever comes
+first.
-Setting this variable to a non-zero value will allow single-character
-options to be bundled. To distinguish bundles from long option names,
-long options must be introduced with B<--> and single-character
-options (and bundles) with B<->. For example,
+=item bundling (default: disabled)
- ps -vax --vax
+Enabling this option will allow single-character options to be
+bundled. To distinguish bundles from long option names, long options
+I<must> be introduced with C<--> and bundles with C<->.
-would be equivalent to
+Note that, if you have options C<a>, C<l> and C<all>, and
+auto_abbrev enabled, possible arguments and option settings are:
- ps -v -a -x --vax
+ using argument sets option(s)
+ ------------------------------------------
+ -a, --a a
+ -l, --l l
+ -al, -la, -ala, -all,... a, l
+ --al, --all all
-provided "vax", "v", "a" and "x" have been defined to be valid
-options.
+The suprising part is that C<--a> sets option C<a> (due to auto
+completion), not C<all>.
-Bundled options can also include a value in the bundle; for strings
-this value is the rest of the bundle, but integer and floating values
-may be combined in the bundle, e.g.
+Note: disabling C<bundling> also disables C<bundling_override>.
- scale -h24w80
+=item bundling_override (default: disabled)
-is equivalent to
+If C<bundling_override> is enabled, bundling is enabled as with
+C<bundling> but now long option names override option bundles.
- scale -h 24 -w 80
+Note: disabling C<bundling_override> also disables C<bundling>.
-Note: resetting B<bundling> also resets B<bundling_override>.
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
-=item bundling_override (default: reset)
+=item ignore_case (default: enabled)
-If B<bundling_override> is set, bundling is enabled as with
-B<bundling> but now long option names override option bundles. In the
-above example, B<-vax> would be interpreted as the option "vax", not
-the bundle "v", "a", "x".
+If enabled, case is ignored when matching long option names. If,
+however, bundling is enabled as well, single character options will be
+treated case-sensitive.
-Note: resetting B<bundling_override> also resets B<bundling>.
+With C<ignore_case>, option specifications for options that only
+differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
+duplicates.
-B<Note:> Using option bundling can easily lead to unexpected results,
-especially when mixing long options and bundles. Caveat emptor.
+Note: disabling C<ignore_case> also disables C<ignore_case_always>.
+
+=item ignore_case_always (default: disabled)
-=item ignore_case (default: set)
+When bundling is in effect, case is ignored on single-character
+options also.
-If set, case is ignored when matching options.
+Note: disabling C<ignore_case_always> also disables C<ignore_case>.
-Note: resetting B<ignore_case> also resets B<ignore_case_always>.
+=item auto_version (default:disabled)
-=item ignore_case_always (default: reset)
+Automatically provide support for the B<--version> option if
+the application did not specify a handler for this option itself.
-When bundling is in effect, case is ignored on single-character
-options also.
+Getopt::Long will provide a standard version message that includes the
+program name, its version (if $main::VERSION is defined), and the
+versions of Getopt::Long and Perl. The message will be written to
+standard output and processing will terminate.
-Note: resetting B<ignore_case_always> also resets B<ignore_case>.
+C<auto_version> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+C<require> statement.
-=item pass_through (default: reset)
+=item auto_help (default:disabled)
-Unknown options are passed through in @ARGV instead of being flagged
-as errors. This makes it possible to write wrapper scripts that
-process only part of the user supplied options, and passes the
+Automatically provide support for the B<--help> and B<-?> options if
+the application did not specify a handler for this option itself.
+
+Getopt::Long will provide a help message using module L<Pod::Usage>. The
+message, derived from the SYNOPSIS POD section, will be written to
+standard output and processing will terminate.
+
+C<auto_help> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+C<require> statement.
+
+=item pass_through (default: disabled)
+
+Options that are unknown, ambiguous or supplied with an invalid option
+value are passed through in C<@ARGV> instead of being flagged as
+errors. This makes it possible to write wrapper scripts that process
+only part of the user supplied command line arguments, and pass the
remaining options to some other program.
-This can be very confusing, especially when B<permute> is also set.
+If C<require_order> is enabled, options processing will terminate at
+the first unrecognized option, or non-option, whichever comes first.
+However, if C<permute> is enabled instead, results can become confusing.
+
+Note that the options terminator (default C<-->), if present, will
+also be passed through in C<@ARGV>.
=item prefix
-The string that starts options. See also B<prefix_pattern>.
+The string that starts options. If a constant string is not
+sufficient, see C<prefix_pattern>.
=item prefix_pattern
Default is C<(--|-|\+)> unless environment variable
POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
-=item debug (default: reset)
+=item debug (default: disabled)
-Enable copious debugging output.
+Enable debugging output.
=back
-=head1 OTHER USEFUL VARIABLES
+=head1 Exportable Methods
-=over 12
+=over
+
+=item VersionMessage
+
+This subroutine provides a standard version message. Its argument can be:
-=item $Getopt::Long::VERSION
+=over 4
-The version number of this Getopt::Long implementation in the format
-C<major>.C<minor>. This can be used to have Exporter check the
-version, e.g.
+=item *
- use Getopt::Long 3.00;
+A string containing the text of a message to print I<before> printing
+the standard message.
-You can inspect $Getopt::Long::major_version and
-$Getopt::Long::minor_version for the individual components.
+=item *
-=item $Getopt::Long::error
+A numeric value corresponding to the desired exit status.
-Internal error flag. May be incremented from a call-back routine to
-cause options parsing to fail.
+=item *
+
+A reference to a hash.
=back
+If more than one argument is given then the entire argument list is
+assumed to be a hash. If a hash is supplied (either as a reference or
+as a list) it should contain one or more elements with the following
+keys:
+
+=over 4
+
+=item C<-message>
+
+=item C<-msg>
+
+The text of a message to print immediately prior to printing the
+program's usage message.
+
+=item C<-exitval>
+
+The desired exit status to pass to the B<exit()> function.
+This should be an integer, or else the string "NOEXIT" to
+indicate that control should simply be returned without
+terminating the invoking process.
+
+=item C<-output>
+
+A reference to a filehandle, or the pathname of a file to which the
+usage message should be written. The default is C<\*STDERR> unless the
+exit value is less than 2 (in which case the default is C<\*STDOUT>).
+
+=back
+
+You cannot tie this routine directly to an option, e.g.:
+
+ GetOptions("version" => \&VersionMessage);
+
+Use this instead:
+
+ GetOptions("version" => sub { VersionMessage() });
+
+=item HelpMessage
+
+This subroutine produces a standard help message, derived from the
+program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
+arguments as VersionMessage(). In particular, you cannot tie it
+directly to an option, e.g.:
+
+ GetOptions("help" => \&HelpMessage);
+
+Use this instead:
+
+ GetOptions("help" => sub { HelpMessage() });
+
+=back
+
+=head1 Return values and Errors
+
+Configuration errors and errors in the option definitions are
+signalled using die() and will terminate the calling program unless
+the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
+}>, or die() was trapped using C<$SIG{__DIE__}>.
+
+GetOptions returns true to indicate success.
+It returns false when the function detected one or more errors during
+option parsing. These errors are signalled using warn() and can be
+trapped with C<$SIG{__WARN__}>.
+
+=head1 Legacy
+
+The earliest development of C<newgetopt.pl> started in 1990, with Perl
+version 4. As a result, its development, and the development of
+Getopt::Long, has gone through several stages. Since backward
+compatibility has always been extremely important, the current version
+of Getopt::Long still supports a lot of constructs that nowadays are
+no longer necessary or otherwise unwanted. This section describes
+briefly some of these 'features'.
+
+=head2 Default destinations
+
+When no destination is specified for an option, GetOptions will store
+the resultant value in a global variable named C<opt_>I<XXX>, where
+I<XXX> is the primary name of this option. When a progam executes
+under C<use strict> (recommended), these variables must be
+pre-declared with our() or C<use vars>.
+
+ our $opt_length = 0;
+ GetOptions ('length=i'); # will store in $opt_length
+
+To yield a usable Perl variable, characters that are not part of the
+syntax for variables are translated to underscores. For example,
+C<--fpp-struct-return> will set the variable
+C<$opt_fpp_struct_return>. Note that this variable resides in the
+namespace of the calling program, not necessarily C<main>. For
+example:
+
+ GetOptions ("size=i", "sizes=i@");
+
+with command line "-size 10 -sizes 24 -sizes 48" will perform the
+equivalent of the assignments
+
+ $opt_size = 10;
+ @opt_sizes = (24, 48);
+
+=head2 Alternative option starters
+
+A string of alternative option starter characters may be passed as the
+first argument (or the first argument after a leading hash reference
+argument).
+
+ my $len = 0;
+ GetOptions ('/', 'length=i' => $len);
+
+Now the command line may look like:
+
+ /length 24 -- arg
+
+Note that to terminate options processing still requires a double dash
+C<-->.
+
+GetOptions() will not interpret a leading C<< "<>" >> as option starters
+if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
+option starters, use C<< "><" >>. Confusing? Well, B<using a starter
+argument is strongly deprecated> anyway.
+
+=head2 Configuration variables
+
+Previous versions of Getopt::Long used variables for the purpose of
+configuring. Although manipulating these variables still work, it is
+strongly encouraged to use the C<Configure> routine that was introduced
+in version 2.17. Besides, it is much easier.
+
+=head1 Trouble Shooting
+
+=head2 GetOptions does not return a false result when an option is not supplied
+
+That's why they're called 'options'.
+
+=head2 GetOptions does not split the command line correctly
+
+The command line is not split by GetOptions, but by the command line
+interpreter (CLI). On Unix, this is the shell. On Windows, it is
+COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
+
+It is important to know that these CLIs may behave different when the
+command line contains special characters, in particular quotes or
+backslashes. For example, with Unix shells you can use single quotes
+(C<'>) and double quotes (C<">) to group words together. The following
+alternatives are equivalent on Unix:
+
+ "two words"
+ 'two words'
+ two\ words
+
+In case of doubt, insert the following statement in front of your Perl
+program:
+
+ print STDERR (join("|",@ARGV),"\n");
+
+to verify how your CLI passes the arguments to the program.
+
+=head2 Undefined subroutine &main::GetOptions called
+
+Are you running Windows, and did you write
+
+ use GetOpt::Long;
+
+(note the capital 'O')?
+
+=head2 How do I put a "-?" option into a Getopt::Long?
+
+You can only obtain this using an alias, and Getopt::Long of at least
+version 2.13.
+
+ use Getopt::Long;
+ GetOptions ("help|?"); # -help and -? will both set $opt_help
+
=head1 AUTHOR
-Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
+Johan Vromans <jvromans@squirrel.nl>
=head1 COPYRIGHT AND DISCLAIMER
-This program is Copyright 1990,1998 by Johan Vromans.
+This program is Copyright 2003,1990 by Johan Vromans.
This program is free software; you can redistribute it and/or
-modify it under the terms of the GNU General Public License
-as published by the Free Software Foundation; either version 2
-of the License, or (at your option) any later version.
+modify it under the terms of the Perl Artistic License or the
+GNU General Public License as published by the Free Software
+Foundation; either version 2 of the License, or (at your option) any
+later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
If you do not have a copy of the GNU General Public License write to
-the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
+the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
MA 02139, USA.
=cut
+
projects / p5sagit/p5-mst-13.2.git / blobdiff