# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Thu Feb 19 09:15:53 2015
-# Update Count : 1682
+# Last Modified On: Mon Aug 12 17:05:46 2019
+# Update Count : 1728
# Status : Released
################ Module Preamble ################
-package Getopt::Long;
-
use 5.004;
use strict;
+use warnings;
+
+package Getopt::Long;
use vars qw($VERSION);
-$VERSION = 2.44;
+$VERSION = 2.51;
# For testing versions only.
use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.44";
+$VERSION_STRING = "2.51";
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
"|".
"0[0-7_]*".
")";
-use constant PAT_FLOAT => "[-+]?[0-9_]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
+use constant PAT_FLOAT =>
+ "[-+]?". # optional sign
+ "(?=[0-9.])". # must start with digit or dec.point
+ "[0-9_]*". # digits before the dec.point
+ "(\.[0-9_]+)?". # optional fraction
+ "([eE][-+]?[0-9_]+)?"; # optional exponent
sub GetOptions(@) {
# Shift in default array.
# Avoid some warnings if debugging.
local ($^W) = 0;
print STDERR
- ("Getopt::Long $Getopt::Long::VERSION ",
+ ("Getopt::Long $Getopt::Long::VERSION_STRING ",
"called from package \"$pkg\".",
"\n ",
"argv: ",
next;
}
$linkage{'<>'} = shift (@optionlist);
- if ( $passthrough ) {
- # Too harsh... for now.
- # $error .= "Option spec <> cannot be used with pass_through\n";
- warn("Option spec <> cannot be used with pass_through. FIX IT!\n");
- }
next;
}
elsif ( $order == $PERMUTE ) {
# Try non-options call-back.
my $cb;
- if ( !$passthrough && (defined ($cb = $linkage{'<>'})) ) {
+ if ( defined ($cb = $linkage{'<>'}) ) {
print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
if $debug;
my $eval_error = do {
}
# Finish.
- if ( @ret && $order == $PERMUTE ) {
+ if ( @ret && ( $order == $PERMUTE || $passthrough ) ) {
# Push back accumulated arguments
print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
if $debug;
(
# Option name
(?: \w+[-\w]* )
- # Alias names, or "?"
- (?: \| (?: \? | \w[-\w]* ) )*
# Aliases
- (?: \| (?: [^-|!+=:][^|!+=:]* )? )*
+ (?: \| (?: . [^|!+=:]* )? )*
)?
(
# Either modifiers ...
# Complete the option name, if appropriate.
if ( @hits == 1 && $hits[0] ne $opt ) {
$tryopt = $hits[0];
- $tryopt = lc ($tryopt) if $ignorecase;
+ $tryopt = lc ($tryopt)
+ if $ignorecase > (($bundling && length($tryopt) == 1) ? 1 : 0);
print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
if $debug;
}
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';
+ if ( $gnu_compat ) {
+ my $optargtype = 0; # none, 1 = empty, 2 = nonempty, 3 = aux
+ if ( defined($optarg) ) {
+ $optargtype = (length($optarg) == 0) ? 1 : 2;
+ }
+ elsif ( defined $rest || @$argv > 0 ) {
+ # GNU getopt_long() does not accept the (optional)
+ # argument to be passed to the option without = sign.
+ # We do, since not doing so breaks existing scripts.
+ $optargtype = 3;
+ }
+ if(($optargtype == 0) && !$mand) {
+ if ( $type eq 'I' ) {
+ # Fake incremental type.
+ my @c = @$ctl;
+ $c[CTL_TYPE] = '+';
+ return (1, $opt, \@c, 1);
+ }
+ my $val
+ = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT]
+ : $type eq 's' ? ''
+ : 0;
+ return (1, $opt, $ctl, $val);
+ }
+ return (1, $opt, $ctl, $type eq 's' ? '' : 0)
+ if $optargtype == 1; # --foo= -> return nothing
}
# Check if there is an option argument available.
}
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'.
my $o_valid = PAT_FLOAT;
if ( $bundling && defined $rest &&
$rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
}
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]
my $o_valid = PAT_FLOAT;
return $arg =~ /^$o_valid$/;
}
my (@options) = @_;
my $prevconfig =
- [ $error, $debug, $major_version, $minor_version,
+ [ $error, $debug, $major_version, $minor_version, $caller,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
$longprefix, $bundling_values ];
if ( ref($options[0]) eq 'ARRAY' ) {
- ( $error, $debug, $major_version, $minor_version,
+ ( $error, $debug, $major_version, $minor_version, $caller,
$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
$longprefix, $bundling_values ) = @{shift(@options)};
}
elsif ( $try eq 'gnu_compat' ) {
$gnu_compat = $action;
+ $bundling = 0;
+ $bundling_values = 1;
}
elsif ( $try =~ /^(auto_?)?version$/ ) {
$auto_version = $action;
my $v = $main::VERSION;
my $fh = $pa->{-output} ||
- ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
+ ( ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR );
print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
$0, defined $v ? " version $v" : (),
# Sneak way to know what version the user requested.
sub VERSION {
- $requested_version = $_[1];
+ $requested_version = $_[1] if @_ > 1;
shift->SUPER::VERSION(@_);
}
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
+values by adding a "@", and pass a reference to a scalar as the
destination:
GetOptions ("library=s@" => \$libfiles);
-Used with the example above, C<@libfiles> (or C<@$libfiles>) would
+Used with the example above, C<@libfiles> c.q. C<@$libfiles> would
contain two strings upon completion: C<"lib/stdlib"> and
C<"lib/extlib">, in that order. It is also possible to specify that
only integer or floating point numbers are acceptable values.
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. Well, actually
-it is an object that stringifies to the argument name.
+subroutine and passes it one parameter: the argument name.
For example:
C<--opt=> will give option C<opt> and empty value.
This is the way GNU getopt_long() does it.
+Note that C<--opt value> is still accepted, even though GNU
+getopt_long() doesn't.
+
=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().
+reasonably compatible with GNU getopt_long().
=item require_order
=item pass_through (default: disabled)
-Anything that is unknown, ambiguous or supplied with an invalid option
-value is 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
+With C<pass_through> anything that is unknown, ambiguous or supplied with
+an invalid option will not be flagged as an error. Instead the unknown
+option(s) will be passed to the catchall C<< <> >> if present, otherwise
+through to C<@ARGV>. 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.
-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.
+If C<require_order> is enabled, options processing will terminate at the
+first unrecognized option, or non-option, whichever comes first and all
+remaining arguments are passed to C<@ARGV> instead of the catchall
+C<< <> >> if present. 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>.
-For obvious reasons, B<pass_through> cannot be used with the
-non-option catchall C<< <> >>.
-
=item prefix
The string that starts options. If a constant string is not
use Getopt::Long;
GetOptions ("help|?"); # -help and -? will both set $opt_help
-Other characters that can't appear in Perl identifiers are also supported
-as aliases with Getopt::Long of at least version 2.39.
+Other characters that can't appear in Perl identifiers are also
+supported in aliases with Getopt::Long of at version 2.39. Note that
+the characters C<!>, C<|>, C<+>, C<=>, and C<:> can only appear as the
+first (or only) character of an alias.
As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
to add the options --help and -? to your program, and handle them.