tlperl 5.22.1 from siep

git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 79 insertions, 29 deletions

diff --git a/Master/tlpkg/tlperl/lib/Getopt/Long.pm b/Master/tlpkg/tlperl/lib/Getopt/Long.pm
index 3ef7d997b85..154c008d3a9 100644
--- a/Master/tlpkg/tlperl/lib/Getopt/Long.pm
+++ b/Master/tlpkg/tlperl/lib/Getopt/Long.pm
@@ -4,8 +4,8 @@
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Tue Oct  1 08:25:52 2013
-# Update Count    : 1651
+# Last Modified On: Mon Feb 23 20:29:11 2015
+# Update Count    : 1683
 # Status          : Released
 
 ################ Module Preamble ################
@@ -17,10 +17,10 @@ use 5.004;
 use strict;
 
 use vars qw($VERSION);
-$VERSION        =  2.42;
+$VERSION        =  2.45;
 # For testing versions only.
 use vars qw($VERSION_STRING);
-$VERSION_STRING = "2.42";
+$VERSION_STRING = "2.45";
 
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK);
@@ -50,6 +50,9 @@ use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
 # Official invisible variables.
 use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
 
+# Really invisible variables.
+my $bundling_values;
+
 # Public subroutines.
 sub config(@);			# deprecated name
 
@@ -92,6 +95,7 @@ sub ConfigDefaults() {
     $passthrough = 0;		# leave unrecognized options alone
     $gnu_compat = 0;		# require --opt=val if value is optional
     $longprefix = "(--)";       # what does a long prefix look like
+    $bundling_values = 0;	# no bundling of values
 }
 
 # Override import.
@@ -296,10 +300,14 @@ sub GetOptionsFromArray(@) {
 	  ("Getopt::Long $Getopt::Long::VERSION ",
 	   "called from package \"$pkg\".",
 	   "\n  ",
-	   "argv: (@$argv)",
+	   "argv: ",
+	   defined($argv)
+	   ? UNIVERSAL::isa( $argv, 'ARRAY' ) ? "(@$argv)" : $argv
+	   : "<undef>",
 	   "\n  ",
 	   "autoabbrev=$autoabbrev,".
 	   "bundling=$bundling,",
+	   "bundling_values=$bundling_values,",
 	   "getopt_compat=$getopt_compat,",
 	   "gnu_compat=$gnu_compat,",
 	   "order=$order,",
@@ -458,6 +466,9 @@ sub GetOptionsFromArray(@) {
 
     }
 
+    $error .= "GetOptionsFromArray: 1st parameter is not an array reference\n"
+      unless $argv && UNIVERSAL::isa( $argv, 'ARRAY' );
+
     # Bail out if errors found.
     die ($error) if $error;
     $error = 0;
@@ -707,7 +718,7 @@ sub GetOptionsFromArray(@) {
 	elsif ( $order == $PERMUTE ) {
 	    # Try non-options call-back.
 	    my $cb;
-	    if ( (defined ($cb = $linkage{'<>'})) ) {
+	    if ( defined ($cb = $linkage{'<>'}) ) {
 		print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
 		  if $debug;
 		my $eval_error = do {
@@ -942,7 +953,7 @@ sub FindOption ($$$$$) {
 
     my $tryopt = $opt;		# option to try
 
-    if ( $bundling && $starter eq '-' ) {
+    if ( ( $bundling || $bundling_values ) && $starter eq '-' ) {
 
 	# To try overrides, obey case ignore.
 	$tryopt = $ignorecase ? lc($opt) : $opt;
@@ -953,6 +964,23 @@ sub FindOption ($$$$$) {
 	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
 	      if $debug;
 	}
+
+	# If bundling_values, option may be followed by the value.
+	elsif ( $bundling_values ) {
+	    $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;
+	    # Whatever remains may not be considered an option.
+	    $optarg = $rest eq '' ? undef : $rest;
+	    $rest = undef;
+	}
+
+	# Split off a single letter and leave the rest for
+	# further processing.
 	else {
 	    $tryopt = $opt;
 	    # Unbundle single letter option.
@@ -1058,6 +1086,7 @@ sub FindOption ($$$$$) {
 	    warn ("Option ", $opt, " does not take an argument\n");
 	    $error++;
 	    undef $opt;
+	    undef $optarg if $bundling_values;
 	}
 	elsif ( $type eq '' || $type eq '+' ) {
 	    # Supply explicit value.
@@ -1286,13 +1315,13 @@ sub Configure (@) {
       [ $error, $debug, $major_version, $minor_version,
 	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
 	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
-	$longprefix ];
+	$longprefix, $bundling_values ];
 
     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,
-	  $longprefix ) = @{shift(@options)};
+	  $longprefix, $bundling_values ) = @{shift(@options)};
     }
 
     my $opt;
@@ -1325,6 +1354,7 @@ sub Configure (@) {
 		$getopt_compat = 0;
                 $genprefix = "(--|-)";
 		$order = $PERMUTE;
+		$bundling_values = 0;
 	    }
 	}
 	elsif ( $try eq 'gnu_compat' ) {
@@ -1344,9 +1374,15 @@ sub Configure (@) {
 	}
 	elsif ( $try eq 'bundling' ) {
 	    $bundling = $action;
+	    $bundling_values = 0 if $action;
 	}
 	elsif ( $try eq 'bundling_override' ) {
 	    $bundling = $action ? 2 : 0;
+	    $bundling_values = 0 if $action;
+	}
+	elsif ( $try eq 'bundling_values' ) {
+	    $bundling_values = $action;
+	    $bundling = 0 if $action;
 	}
 	elsif ( $try eq 'require_order' ) {
 	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
@@ -2134,12 +2170,12 @@ at once. For example if C<a>, C<v> and C<x> are all valid options,
 
     -vax
 
-would set all three.
+will set all three.
 
-Getopt::Long supports two levels of bundling. To enable bundling, a
+Getopt::Long supports three styles of bundling. To enable bundling, a
 call to Getopt::Long::Configure is required.
 
-The first level of bundling can be enabled with:
+The simplest style of bundling can be enabled with:
 
     Getopt::Long::Configure ("bundling");
 
@@ -2150,21 +2186,21 @@ options,
 
     -vax
 
-would set C<a>, C<v> and C<x>, but
+will set C<a>, C<v> and C<x>, but
 
     --vax
 
-would set C<vax>.
+will set C<vax>.
 
-The second level of bundling lifts this restriction. It can be enabled
+The second style of bundling lifts this restriction. It can be enabled
 with:
 
     Getopt::Long::Configure ("bundling_override");
 
-Now, C<-vax> would set the option C<vax>.
+Now, C<-vax> will set the option C<vax>.
 
-When any level of bundling is enabled, option values may be inserted
-in the bundle. For example:
+In all of the above cases, option values may be inserted in the
+bundle. For example:
 
     -h24w80
 
@@ -2172,6 +2208,17 @@ is equivalent to
 
     -h 24 -w 80
 
+A third style of bundling allows only values to be bundled with
+options. It can be enabled with:
+
+    Getopt::Long::Configure ("bundling_values");
+
+Now, C<-h24> will set the option C<h> to C<24>, but option bundles
+like C<-vxa> and C<-h24w80> are flagged as errors.
+
+Enabling C<bundling_values> will disable the other two styles of
+bundling.
+
 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,
@@ -2399,15 +2446,18 @@ 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
+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>.
@@ -2673,7 +2723,7 @@ Johan Vromans <jvromans@squirrel.nl>
 
 =head1 COPYRIGHT AND DISCLAIMER
 
-This program is Copyright 1990,2013 by Johan Vromans.
+This program is Copyright 1990,2015 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
diff --git a/Master/tlpkg/tlperl/lib/Getopt/Std.pm b/Master/tlpkg/tlperl/lib/Getopt/Std.pm
index ecb7ebbf971..b7f8132b381 100644
--- a/Master/tlpkg/tlperl/lib/Getopt/Std.pm
+++ b/Master/tlpkg/tlperl/lib/Getopt/Std.pm
@@ -36,8 +36,8 @@ The C<getopts()> function returns true unless an invalid option was found.
 The C<getopt()> function is similar, but its argument is a string containing
 all switches that take an argument.  If no argument is provided for a switch,
 say, C<y>, the corresponding C<$opt_y> will be set to an undefined value.
-Unspecified switches are silently accepted.  B<Use of C<getopts()> is not
-recommended.>
+Unspecified switches are silently accepted.  Use of C<getopt()> is not
+recommended.
 
 Note that, if your code is running under the recommended C<use strict
 vars> pragma, you will need to declare these package variables
@@ -81,7 +81,7 @@ and version_mess() with the switches string as an argument.
 
 @ISA = qw(Exporter);
 @EXPORT = qw(getopt getopts);
-$VERSION = '1.10';
+$VERSION = '1.11';
 # uncomment the next line to disable 1.03-backward compatibility paranoia
 # $STANDARD_HELP_VERSION = 1;