summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm89
1 files changed, 58 insertions, 31 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm
index 8263e21713..fda1fc3a8f 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Getopt/Long.pm
@@ -4,12 +4,14 @@
# Author : Johan Vromans
# Created On : Tue Sep 11 15:00:12 1990
# Last Modified By: Johan Vromans
-# Last Modified On: Tue Aug 18 14:48:05 2020
-# Update Count : 1739
+# Last Modified On: Thu Nov 17 17:45:27 2022
+# Update Count : 1777
# Status : Released
################ Module Preamble ################
+# There are no CPAN testers for very old versions of Perl.
+# Getopt::Long is reported to run under 5.8.
use 5.004;
use strict;
@@ -18,10 +20,10 @@ use warnings;
package Getopt::Long;
use vars qw($VERSION);
-$VERSION = 2.52;
+$VERSION = 2.54;
# For testing versions only.
use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.52";
+$VERSION_STRING = "2.54";
use Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -258,9 +260,9 @@ use constant PAT_XINT =>
")";
use constant PAT_FLOAT =>
"[-+]?". # optional sign
- "(?=[0-9.])". # must start with digit or dec.point
+ "(?=\\.?[0-9])". # must start with digit or dec.point
"[0-9_]*". # digits before the dec.point
- "(\.[0-9_]+)?". # optional fraction
+ "(\\.[0-9_]*)?". # optional fraction
"([eE][-+]?[0-9_]+)?"; # optional exponent
sub GetOptions(@) {
@@ -525,8 +527,9 @@ sub GetOptionsFromArray(@) {
my $key; # key (if hash type)
my $arg; # option argument
my $ctl; # the opctl entry
+ my $starter; # the actual starter character(s)
- ($found, $opt, $ctl, $arg, $key) =
+ ($found, $opt, $ctl, $starter, $arg, $key) =
FindOption ($argv, $prefix, $argend, $opt, \%opctl);
if ( $found ) {
@@ -606,12 +609,13 @@ sub GetOptionsFromArray(@) {
eval {
&{$linkage{$opt}}
(Getopt::Long::CallBack->new
- (name => $opt,
- given => $given,
- ctl => $ctl,
- opctl => \%opctl,
- linkage => \%linkage,
- prefix => $prefix,
+ (name => $opt,
+ given => $given,
+ ctl => $ctl,
+ opctl => \%opctl,
+ linkage => \%linkage,
+ prefix => $prefix,
+ starter => $starter,
),
$ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
$arg);
@@ -818,7 +822,7 @@ sub ParseOptionSpec ($$) {
[=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
|
# ... or an optional-with-default spec
- : (?: -?\d+ | \+ ) [@%]?
+ : (?: 0[0-7]+ | 0[xX][0-9a-fA-F]+ | 0[bB][01]+ | -?\d+ | \+ ) [@%]?
)?
$;x ) {
return (undef, "Error in option spec: \"$opt\"\n");
@@ -851,10 +855,23 @@ sub ParseOptionSpec ($$) {
# Fields are hard-wired here.
$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
}
- elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
+ elsif ( $spec =~ /^:(0[0-7]+|0x[0-9a-f]+|0b[01]+|-?\d+|\+)([@%])?$/i ) {
my $def = $1;
my $dest = $2;
- my $type = $def eq '+' ? 'I' : 'i';
+ my $type = 'i'; # assume integer
+ if ( $def eq '+' ) {
+ # Increment.
+ $type = 'I';
+ }
+ elsif ( $def =~ /^(0[0-7]+|0[xX][0-9a-fA-F]+|0[bB][01]+)$/ ) {
+ # Octal, binary or hex.
+ $type = 'o';
+ $def = oct($def);
+ }
+ elsif ( $def =~ /^-?\d+$/ ) {
+ # Integer.
+ $def = 0 + $def;
+ }
$dest ||= '$';
$dest = $dest eq '@' ? CTL_DEST_ARRAY
: $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
@@ -923,7 +940,7 @@ sub ParseOptionSpec ($$) {
# Option lookup.
sub FindOption ($$$$$) {
- # returns (1, $opt, $ctl, $arg, $key) if okay,
+ # returns (1, $opt, $ctl, $starter, $arg, $key) if okay,
# returns (1, undef) if option in error,
# returns (0) otherwise.
@@ -1104,7 +1121,7 @@ sub FindOption ($$$$$) {
$arg = 0; # supply explicit value
}
unshift (@$argv, $starter.$rest) if defined $rest;
- return (1, $opt, $ctl, $arg);
+ return (1, $opt, $ctl, $starter, $arg);
}
# Get mandatory status and type info.
@@ -1127,15 +1144,15 @@ sub FindOption ($$$$$) {
# Fake incremental type.
my @c = @$ctl;
$c[CTL_TYPE] = '+';
- return (1, $opt, \@c, 1);
+ return (1, $opt, \@c, $starter, 1);
}
my $val
= defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT]
: $type eq 's' ? ''
: 0;
- return (1, $opt, $ctl, $val);
+ return (1, $opt, $ctl, $starter, $val);
}
- return (1, $opt, $ctl, $type eq 's' ? '' : 0)
+ return (1, $opt, $ctl, $starter, $type eq 's' ? '' : 0)
if $optargtype == 1; # --foo= -> return nothing
}
@@ -1155,9 +1172,9 @@ sub FindOption ($$$$$) {
# Fake incremental type.
my @c = @$ctl;
$c[CTL_TYPE] = '+';
- return (1, $opt, \@c, 1);
+ return (1, $opt, \@c, $starter, 1);
}
- return (1, $opt, $ctl,
+ return (1, $opt, $ctl, $starter,
defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
$type eq 's' ? '' : 0);
}
@@ -1187,16 +1204,16 @@ sub FindOption ($$$$$) {
if ( $type eq 's' ) { # string
# A mandatory string takes anything.
- return (1, $opt, $ctl, $arg, $key) if $mand;
+ return (1, $opt, $ctl, $starter, $arg, $key) if $mand;
# Same for optional string as a hash value
- return (1, $opt, $ctl, $arg, $key)
+ return (1, $opt, $ctl, $starter, $arg, $key)
if $ctl->[CTL_DEST] == CTL_DEST_HASH;
# An optional string takes almost anything.
- return (1, $opt, $ctl, $arg, $key)
+ return (1, $opt, $ctl, $starter, $arg, $key)
if defined $optarg || defined $rest;
- return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
+ return (1, $opt, $ctl, $starter, $arg, $key) if $arg eq "-"; # ??
# Check for option or option list terminator.
if ($arg eq $argend ||
@@ -1248,7 +1265,7 @@ sub FindOption ($$$$$) {
# Fake incremental type.
my @c = @$ctl;
$c[CTL_TYPE] = '+';
- return (1, $opt, \@c, 1);
+ return (1, $opt, \@c, $starter, 1);
}
# Supply default value.
$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
@@ -1293,7 +1310,7 @@ sub FindOption ($$$$$) {
else {
die("Getopt::Long internal error (Can't happen)\n");
}
- return (1, $opt, $ctl, $arg, $key);
+ return (1, $opt, $ctl, $starter, $arg, $key);
}
sub ValidValue ($$$$$) {
@@ -1529,8 +1546,9 @@ sub setup_pa_args($@) {
if ( UNIVERSAL::isa($pa, 'HASH') ) {
# Get rid of -msg vs. -message ambiguity.
- $pa->{-message} = $pa->{-msg};
- delete($pa->{-msg});
+ if (!defined $pa->{-message}) {
+ $pa->{-message} = delete($pa->{-msg});
+ }
}
elsif ( $pa =~ /^-?\d+$/ ) {
$pa = { -exitval => $pa };
@@ -1714,6 +1732,9 @@ 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>.
+(If both C<--verbose> and C<--noverbose> are given, whichever is given
+last takes precedence.)
+
An incremental option is specified with a plus C<+> after the
option name:
@@ -1766,6 +1787,10 @@ 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>.
+(If the same option appears more than once on the command line, the
+last given value is used. If you want to take all the values, see
+below.)
+
=head2 Options with multiple values
Options sometimes take several values. For example, a program could
@@ -2010,6 +2035,8 @@ considered an option on itself.
Like C<:i>, but if the value is omitted, the I<number> will be assigned.
+If the I<number> is octal, hexadecimal or binary, behaves like C<:o>.
+
=item : + [ I<desttype> ]
Like C<:i>, but if the value is omitted, the current value for the