package Getopt::Long;
-# RCS Status : $Id: GetoptLong.pl,v 2.22 2000-03-05 21:08:03+01 jv Exp $
+# RCS Status : $Id: GetoptLong.pm,v 2.47 2001-11-15 18:14:22+01 jv Exp $
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Sun Mar 5 21:08:55 2000
-# Update Count : 720
+# Last Modified On: Thu Nov 15 18:13:36 2001
+# Update Count : 987
# Status : Released
################ Copyright ################
-# This program is Copyright 1990,2000 by Johan Vromans.
+# This program is Copyright 1990,2001 by Johan Vromans.
# This program is free software; you can redistribute it and/or
# modify it under the terms of the Perl Artistic License or the
# GNU General Public License as published by the Free Software
################ Module Preamble ################
+use 5.004;
+
use strict;
-BEGIN {
- require 5.004;
- use Exporter ();
- use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
- $VERSION = "2.21";
+use vars qw($VERSION);
+$VERSION = 2.26_03;
+# For testing versions only.
+use vars qw($VERSION_STRING);
+$VERSION_STRING = "2.26_03";
+
+use Exporter;
- @ISA = qw(Exporter);
+use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+@ISA = qw(Exporter);
+%EXPORT_TAGS = qw();
+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 = qw();
@EXPORT_OK = qw();
- use AutoLoader qw(AUTOLOAD);
}
# User visible variables.
use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
$passthrough);
# Official invisible variables.
-use vars qw($genprefix $caller);
+use vars qw($genprefix $caller $gnu_compat);
# Public subroutines.
sub Configure (@);
# Private subroutines.
sub ConfigDefaults ();
-sub FindOption ($$$$$$$);
+sub ParseOptionSpec ($$);
+sub OptCtl ($);
+sub FindOption ($$$$);
sub Croak (@); # demand loading the real Croak
################ Local Variables ################
$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;
+ $pkg->SUPER::import(@syms);
+ # And configure.
+ Configure (@config) if @config;
}
################ Initialization ################
ConfigDefaults();
-################ Object Oriented routines ################
+################ OO Interface ################
-=experimental
+package Getopt::Long::Parser;
# NOTE: The object oriented routines use $error for thread locking.
-eval "sub lock{}" if $] < 5.005;
+my $_lock = sub {
+ lock ($Getopt::Long::error) if $] >= 5.005
+};
# 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 { lock ($error); Configure () };
+my $default_config = do {
+ &$_lock;
+ Getopt::Long::Configure ()
+};
sub new {
my $that = shift;
my $class = ref($that) || $that;
+ my %atts = @_;
# Register the callers package.
- my $self = { caller => (caller)[0] };
+ my $self = { caller_pkg => (caller)[0] };
bless ($self, $class);
- # Process construct time configuration.
- if ( @_ > 0 ) {
- lock ($error);
- my $save = Configure ($default_config, @_);
- $self->{settings} = Configure ($save);
+ # Process config attributes.
+ if ( defined $atts{config} ) {
+ &$_lock;
+ 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
+ Getopt::Long::Croak(__PACKAGE__.": unhandled attributes: ".
+ join(" ", sort(keys(%atts))));
+ }
+
$self;
}
sub configure {
my ($self) = shift;
- lock ($error);
+ &$_lock;
# Restore settings, merge new settings in.
- my $save = Configure ($self->{settings}, @_);
+ my $save = Getopt::Long::Configure ($self->{settings}, @_);
# Restore orig config and save the new config.
$self->{settings} = Configure ($save);
sub getoptions {
my ($self) = shift;
- lock ($error);
+ &$_lock;
# Restore config settings.
- my $save = Configure ($self->{settings});
+ my $save = Getopt::Long::Configure ($self->{settings});
# Call main routine.
my $ret = 0;
- $caller = $self->{caller};
- eval { $ret = GetOptions (@_); };
+ $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.
- Configure ($save);
+ Getopt::Long::Configure ($save);
# Handle errors and return value.
die ($@) if $@;
return $ret;
}
-=cut
+package Getopt::Long;
-################ Package return ################
+# Indices in option control info.
+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_XINT => 'o';
+#use constant CTL_TYPE_FLOAT => 'f';
+#use constant CTL_TYPE_STRING => 's';
-1;
+use constant CTL_MAND => 1;
-__END__
+use constant CTL_DEST => 2;
+ use constant CTL_DEST_SCALAR => 0;
+ use constant CTL_DEST_ARRAY => 1;
+ use constant CTL_DEST_HASH => 2;
+ use constant CTL_DEST_CODE => 3;
-################ AutoLoading subroutines ################
+use constant CTL_RANGE => 3;
-# RCS Status : $Id: GetoptLongAl.pl,v 2.25 2000-03-05 21:08:03+01 jv Exp $
-# Author : Johan Vromans
-# Created On : Fri Mar 27 11:50:30 1998
-# Last Modified By: Johan Vromans
-# Last Modified On: Sat Mar 4 16:33:02 2000
-# Update Count : 49
-# Status : Released
+use constant CTL_REPEAT => 4;
+
+use constant CTL_CNAME => 5;
sub GetOptions {
my @optionlist = @_; # local copy of the option descriptions
my $argend = '--'; # option list terminator
- my %opctl = (); # table of arg.specs (long and abbrevs)
- my %bopctl = (); # table of arg.specs (bundles)
+ my %opctl = (); # table of option specs
my $pkg = $caller || (caller)[0]; # current context
# Needed if linkage is omitted.
- my %aliases= (); # alias table
my @ret = (); # accum for non-options
my %linkage; # linkage
my $userlinkage; # user supplied HASH
my $opt; # current option
- my $genprefix = $genprefix; # so we can call the same module many times
- my @opctl; # the possible long option names
+ my $prefix = $genprefix; # current prefix
$error = '';
- print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
+ print STDERR ("GetOpt::Long $Getopt::Long::VERSION (",
+ '$Revision: 2.47 $', ") ",
"called from package \"$pkg\".",
"\n ",
- 'GetOptionsAl $Revision: 2.25 $ ',
- "\n ",
"ARGV: (@ARGV)",
"\n ",
"autoabbrev=$autoabbrev,".
"bundling=$bundling,",
"getopt_compat=$getopt_compat,",
+ "gnu_compat=$gnu_compat,",
"order=$order,",
"\n ",
"ignorecase=$ignorecase,",
# First argument may be an object. It's OK to use this as long
# 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.
# Be careful not to interpret '<>' as option starters.
- if ( $optionlist[0] =~ /^\W+$/
+ if ( @optionlist && $optionlist[0] =~ /^\W+$/
&& !($optionlist[0] eq '<>'
&& @optionlist > 0
&& ref($optionlist[1])) ) {
- $genprefix = shift (@optionlist);
+ $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)
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;
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 ( 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 "HASH" ) {
+ $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
}
- 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 "SCALAR" || $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;
-
# 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 = " ";
}
}
my $goon = 1;
while ( $goon && @ARGV > 0 ) {
- #### Get next argument ####
-
+ # Get next argument.
$opt = shift (@ARGV);
- 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);
- }
+ last if $opt eq $argend;
+ # Look it up.
my $tryopt = $opt;
my $found; # success status
- my $dsttype; # destination type ('@' or '%')
- my $incr; # destination increment
my $key; # key (if hash type)
my $arg; # option argument
+ my $ctl; # the opctl entry
- ($found, $opt, $arg, $dsttype, $incr, $key) =
- FindOption ($genprefix, $argend, $opt,
- \%opctl, \%bopctl, \@opctl, \%aliases);
+ ($found, $opt, $ctl, $arg, $key) =
+ FindOption ($prefix, $argend, $opt, \%opctl);
if ( $found ) {
next unless defined $opt;
if ( defined $arg ) {
- $opt = $aliases{$opt} if defined $aliases{$opt};
+
+ # 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' ) {
- if ( $incr ) {
+ if ( $ctl->[CTL_TYPE] eq '+' ) {
print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
if $debug;
if ( defined ${$linkage{$opt}} ) {
$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;
local ($@);
eval {
- &{$linkage{$opt}}($opt, $arg);
+ local $SIG{__DIE__} = '__DEFAULT__';
+ &{$linkage{$opt}}($opt,
+ $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+ $arg);
};
print STDERR ("=> die($@)\n") if $debug && $@ ne '';
- if ( $@ =~ /^FINISH\b/ ) {
- $goon = 0;
+ if ( $@ =~ /^!/ ) {
+ if ( $@ =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
}
elsif ( $@ ne '' ) {
warn ($@);
}
}
# No entry in linkage means entry in userlinkage.
- elsif ( $dsttype eq '@' ) {
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
if $debug;
$userlinkage->{$opt} = [$arg];
}
}
- elsif ( $dsttype eq '%' ) {
+ elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
if ( defined $userlinkage->{$opt} ) {
print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
if $debug;
}
}
else {
- if ( $incr ) {
+ if ( $ctl->[CTL_TYPE] eq '+' ) {
print STDERR ("=> \$L{$opt} += \"$arg\"\n")
if $debug;
if ( defined $userlinkage->{$opt} ) {
my $cb;
if ( (defined ($cb = $linkage{'<>'})) ) {
local ($@);
+ print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
+ if $debug;
eval {
+ local $SIG{__DIE__} = '__DEFAULT__';
&$cb ($tryopt);
};
print STDERR ("=> die($@)\n") if $debug && $@ ne '';
- if ( $@ =~ /^FINISH\b/ ) {
- $goon = 0;
+ if ( $@ =~ /^!/ ) {
+ if ( $@ =~ /^!FINISH\b/ ) {
+ $goon = 0;
+ }
}
elsif ( $@ ne '' ) {
warn ($@);
}
# 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);
}
+# 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_MAND] ? "O" : "M",
+ ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
+ $v[CTL_RANGE] || '',
+ $v[CTL_REPEAT] || '',
+ "\"$v[CTL_CNAME]\"",
+ ). "]";
+}
+
+# Parse an option specification and fill the tables.
+sub ParseOptionSpec ($$) {
+ my ($opt, $opctl) = @_;
+
+ # Match option spec. Allow '?' as an alias only.
+ if ( $opt !~ m;^
+ (
+ # Option name
+ (?: \w+[-\w]* )
+ # Alias names, or "?"
+ (?: \| (?: \? | \w[-\w]* )? )*
+ )?
+ (
+ # Either modifiers ...
+ [!+]
+ |
+ # ... or a value/dest specification.
+ [=:][ionfs][@%]?
+ )?
+ $;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 '!' ) {
+ $entry = [$spec,0,CTL_DEST_SCALAR,undef,undef,$orig];
+ }
+ else {
+ my ($mand, $type, $dest) = $spec =~ /([=:])([ionfs])([@%])?/;
+ $type = 'i' if $type eq 'n';
+ $dest ||= '$';
+ $dest = $dest eq '@' ? CTL_DEST_ARRAY
+ : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+ $entry = [$type,$mand eq '=',$dest,undef,undef,$orig];
+ }
+
+ # Process all names. First is canonical, the rest are aliases.
+ foreach ( @names ) {
+
+ $_ = lc ($_)
+ if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
+
+ if ( $spec eq '!' ) {
+ $opctl->{"no$_"} = $entry;
+ $opctl->{$_} = [@$entry];
+ $opctl->{$_}->[CTL_TYPE] = '';
+ }
+ else {
+ $opctl->{$_} = $entry;
+ }
+ }
+
+ ($names[0], $orig);
+}
+
# Option lookup.
-sub FindOption ($$$$$$$) {
+sub FindOption ($$$$) {
- # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
+ # returns (1, $opt, $ctl, $arg, $key) if okay,
+ # returns (1, undef) if option in error,
# returns (0) otherwise.
- my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
- my $key; # hash key for a hash option
- my $arg;
+ my ($prefix, $argend, $opt, $opctl) = @_;
- print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
+ print STDERR ("=> find \"$opt\"\n") if $debug;
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,
#### Look it up ###
- my $tryopt = $opt; # option to try
- my $optbl = $opctl; # table to look it up (long names)
- my $type;
- my $dsttype = '';
- my $incr = 0;
+ my $tryopt; # option to try
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 ($rest) 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/, @{$names});
+ my @hits = grep (/^$pat/, @names);
print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
- "out of ", scalar(@{$names}), "\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;
}
# Now see if it really is ambiguous.
warn ("Option ", $opt, " is ambiguous (",
join(", ", @hits), ")\n");
$error++;
- undef $opt;
- return (1, $opt,$arg,$dsttype,$incr,$key);
+ return (1, undef);
}
@hits = keys(%hit);
}
}
# Check validity by fetching the info.
- $type = $optbl->{$tryopt} unless defined $type;
- unless ( defined $type ) {
+ my $ctl = $opctl->{$tryopt};
+ unless ( defined $ctl ) {
return (0) if $passthrough;
warn ("Unknown option: ", $opt, "\n");
$error++;
- return (1, $opt,$arg,$dsttype,$incr,$key);
+ 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.
+ my $type = $ctl->[CTL_TYPE];
+ my $arg;
+
if ( $type eq '' || $type eq '!' || $type eq '+' ) {
if ( defined $optarg ) {
return (0) if $passthrough;
}
elsif ( $type eq '' || $type eq '+' ) {
$arg = 1; # supply explicit value
- $incr = $type eq '+';
}
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, $opt,$arg,$dsttype,$incr,$key);
+ return (1, $opt, $ctl, $arg);
}
# Get mandatory status and type info.
- my $mand;
- ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
+ my $mand = $ctl->[CTL_MAND];
# Check if there is an option argument available.
- if ( defined $optarg ? ($optarg eq '')
+ 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 '')
: !(defined $rest || @ARGV > 0) ) {
# Complain if this option needs an argument.
- if ( $mand eq "=" ) {
+ if ( $mand ) {
return (0) if $passthrough;
warn ("Option ", $opt, " requires an argument\n");
$error++;
- undef $opt;
- }
- if ( $mand eq ":" ) {
- $arg = $type eq "s" ? '' : 0;
+ return (1, undef);
}
- return (1, $opt,$arg,$dsttype,$incr,$key);
+ return (1, $opt, $ctl, $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 ($dsttype eq '%' && defined $arg) {
+ my $key;
+ if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
}
if ( $type eq "s" ) { # string
# A mandatory string takes anything.
- return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
+ return (1, $opt, $ctl, $arg, $key) if $mand;
# An optional string takes almost anything.
- return (1, $opt,$arg,$dsttype,$incr,$key)
+ return (1, $opt, $ctl, $arg, $key)
if defined $optarg || defined $rest;
- return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
+ return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
# Check for option or option list terminator.
if ($arg eq $argend ||
}
}
- elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
- if ( $bundling && defined $rest && $rest =~ /^([-+]?[0-9]+)(.*)$/s ) {
+ elsif ( $type eq "i" # numeric/integer
+ || $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 =~ /^($o_valid)(.*)$/si ) {
$arg = $1;
$rest = $2;
+ $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);
}
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, $starter.$rest) if defined $rest && $rest ne '';
}
elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
- if ( defined $optarg || $mand eq "=" ) {
+ if ( defined $optarg || $mand ) {
if ( $passthrough ) {
unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
unless defined $optarg;
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");
}
- return (1, $opt, $arg, $dsttype, $incr, $key);
+ return (1, $opt, $ctl, $arg, $key);
}
# Getopt::Long Configuration.
my $prevconfig =
[ $error, $debug, $major_version, $minor_version,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
- $passthrough, $genprefix ];
+ $gnu_compat, $passthrough, $genprefix ];
if ( ref($options[0]) eq 'ARRAY' ) {
( $error, $debug, $major_version, $minor_version,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
- $passthrough, $genprefix ) = @{shift(@options)};
+ $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)};
}
my $opt;
$action = 0;
$try = $+;
}
- if ( $try eq 'default' or $try eq 'defaults' ) {
- ConfigDefaults () if $action;
+ 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 eq 'ignorecase' or $try eq 'ignore_case' ) {
$ignorecase = $action;
}
elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
$passthrough = $action;
}
- elsif ( $try =~ /^prefix=(.+)$/ ) {
+ elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
$genprefix = $1;
# Turn into regexp. Needs to be parenthesized!
$genprefix = "(" . quotemeta($genprefix) . ")";
eval { '' =~ /$genprefix/; };
Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
}
- elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
+ elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
$genprefix = $1;
# Parenthesize if needed.
$genprefix = "(" . $genprefix . ")"
=head1 SYNOPSIS
use Getopt::Long;
- $result = GetOptions (...option-descriptions...);
+ my $data = "file.dat";
+ my $length = 24;
+ my $verbose;
+ $result = GetOptions ("length=i" => \$length, # numeric
+ "file=s" => \$data, # string
+ "verbose" => \$verbose); # flag
=head1 DESCRIPTION
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
+like
--size=24
=head1 Getting Started with Getopt::Long
Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
-the firs Perl module that provided support for handling the new style
+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
Getopt::Long supports two useful variants of simple options:
I<negatable> options and I<incremental> options.
-A negatable option is specified with a exclamation mark C<!> after the
+A negatable option is specified with an exclamation mark C<!> after the
option name:
my $verbose = ''; # option variable with default value (false)
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 arguments: the name of the option,
-and the value to be assigned. It is up to the subroutine to store the
-value, or do whatever it thinks is appropriate.
+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:
die(), issue the error message, and record that an error result must
be returned upon completion.
-It is also possible for a user-defined subroutine to preliminary
-terminate options processing by calling die() with argument
-C<"FINISH">. GetOptions will react as if it encountered a double dash
-C<-->.
+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
=head2 Summary of Option Specifications
Each option specifier consists of two parts: the name specification
-and the argument 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.
+characters.
length option name is "length"
length|size|l name is "length", aliases are "size" and "l"
The argument specification can be
-=over
+=over 4
=item !
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> (a value of 0 will be assigned).
+assigned) and C<--nofoo> (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 +
The option requires an argument of the given type. Supported types
are:
-=over
+=over 4
=item s
Integer. An optional leading plus or minus sign, followed by a
sequence of digits.
+=item o
+
+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').
+
=item f
Real number. For example C<3.14>, C<-6.23E24> and so on.
=head1 Advanced Possibilities
+=head2 Object oriented interface
+
+Getopt::Long can be used in an object oriented way as well:
+
+ use Getopt::Long;
+ $p = new Getopt::Long::Parser;
+ $p->configure(...configuration options...);
+ if ($p->getoptions(...options descriptions...)) ...
+
+Configuration options can be passed to the constructor:
+
+ $p = new Getopt::Long::Parser
+ config => [...configuration options...];
+
+For thread safety, each method call will acquire an exclusive lock to
+the Getopt::Long module. So don't call these methods from a callback
+routine!
+
=head2 Documentation and help texts
Getopt::Long encourages the use of Pod::Usage to produce help
-vax
-would set C<a>, C<v> and C<x>, but
+would set C<a>, C<v> and C<x>, but
--vax
=head2 The lonesome dash
-Some applications require the option C<-> (that's a lone dash). This
-can be achieved by adding an option specification with an empty name:
+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 legal, and set options
-variable C<$stdio>.
+A lone dash on the command line will now be a legal option, and using
+it will set variable C<$stdio>.
-=head2 Argument call-back
+=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 the argument as a parameter.
+subroutine and passes it one parameter: the argument name.
For example:
arg1 --width=72 arg2 --width=60 arg3
-This will call
-C<process("arg1")> while C<$width> is C<80>,
+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>.
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 set, e.g.
-C<ignore_case>, or reset, e.g. C<no_ignore_case>. Case does not
+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:
=over 12
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 C<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 set unless environment variable
-POSIXLY_CORRECT has been set, in which case C<getopt_compat> is reset.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
+
+=item gnu_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.
+
+=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 command line arguments are allowed to be mixed with options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case C<require_order> is reset.
+Default is disabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
See also C<permute>, which is the opposite of C<require_order>.
=item permute
Whether command line arguments are allowed to be mixed with options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case C<permute> is reset.
+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 C<permute> is set, this means that
+If C<permute> is enabled, this means that
--foo arg1 --bar arg2 arg3
--foo --bar arg1 arg2 arg3
-If an argument call-back routine is specified, C<@ARGV> will always be
+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
-will call the call-back routine for arg1 and arg2, and terminate
-GetOptions() leaving C<"arg2"> in C<@ARGV>.
+This will call the callback routine for arg1 and arg2, and then
+terminate GetOptions() leaving C<"arg2"> in C<@ARGV>.
-If C<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
-=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 option will allow single-character options to be bundled.
+=item bundling (default: disabled)
+
+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 single-character options (and bundles) with
C<->.
-Note: resetting C<bundling> also resets C<bundling_override>.
+Note: disabling C<bundling> also disables C<bundling_override>.
-=item bundling_override (default: reset)
+=item bundling_override (default: disabled)
-If C<bundling_override> is set, bundling is enabled as with
-C<bundling> but now long option names override option bundles.
+If C<bundling_override> is enabled, bundling is enabled as with
+C<bundling> but now long option names override option bundles.
-Note: resetting C<bundling_override> also resets C<bundling>.
+Note: disabling C<bundling_override> also disables C<bundling>.
B<Note:> Using option bundling can easily lead to unexpected results,
especially when mixing long options and bundles. Caveat emptor.
-=item ignore_case (default: set)
+=item ignore_case (default: enabled)
-If set, case is ignored when matching long option names. Single
+If enabled, case is ignored when matching long option names. Single
character options will be treated case-sensitive.
-Note: resetting C<ignore_case> also resets C<ignore_case_always>.
+Note: disabling C<ignore_case> also disables C<ignore_case_always>.
-=item ignore_case_always (default: reset)
+=item ignore_case_always (default: disabled)
When bundling is in effect, case is ignored on single-character
-options also.
+options also.
-Note: resetting C<ignore_case_always> also resets C<ignore_case>.
+Note: disabling C<ignore_case_always> also disables C<ignore_case>.
-=item pass_through (default: reset)
+=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
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 C<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.
=item prefix
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
the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
}>, or die() was trapped using C<$SIG{__DIE__}>.
-A return value of 1 (true) indicates success.
-
-A return status of 0 (false) indicates that the function detected one
-or more errors during option parsing. These errors are signalled using
-warn() and can be trapped with C<$SIG{__WARN__}>.
+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__}>.
Errors that can't happen are signalled using Carp::croak().
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
+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 new C<config> routine. Besides, it
-is much easier.
+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 Warning: Ignoring '!' modifier for short option
+
+This warning is issued when the '!' modifier is applied to a short
+(one-character) option and bundling is in effect. E.g.,
+
+ Getopt::Long::Configure("bundling");
+ GetOptions("foo|f!" => \$foo);
+
+Note that older Getopt::Long versions did not issue a warning, because
+the '!' modifier was applied to the first name only. This bug was
+fixed in 2.22.
+
+Solution: separate the long and short names and apply the '!' to the
+long names only, e.g.,
+
+ GetOptions("foo!" => \$foo, "f" => \$foo);
+
+=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 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 2000,1990 by Johan Vromans.
+This program is Copyright 2001,1990 by Johan Vromans.
This program is free software; you can redistribute it and/or
modify it under the terms of the Perl Artistic License or the
GNU General Public License as published by the Free Software
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
-# Local Variables:
-# mode: perl
-# eval: (load-file "pod.el")
-# End: