In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/8a60db598978597921ccbea6b554edfee16642a8?hp=0cf583b0808e2fb2ac90751d506f2b8ff75aed86>
- Log ----------------------------------------------------------------- commit 8a60db598978597921ccbea6b554edfee16642a8 Author: Chris 'BinGOs' Williams <[email protected]> Date: Wed Jan 14 16:07:44 2015 +0000 Update Getopt-Long to CPAN version 2.43 [DELTA] Changes in version 2.43 ----------------------- * Fix bug https://rt.cpan.org/Ticket/Display.html?id=92462 * Implement enhancement https://rt.cpan.org/Public/Bug/Display.html?id=101537 * Fix the Getopt::Long part of bug https://rt.cpan.org/Ticket/Display.html?id=100335 ----------------------------------------------------------------------- Summary of changes: Porting/Maintainers.pl | 2 +- cpan/Getopt-Long/lib/Getopt/Long.pm | 95 +++++++++++++++++++++++++++++-------- 2 files changed, 75 insertions(+), 22 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 6c465d1..21284a5 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -571,7 +571,7 @@ use File::Glob qw(:case); }, 'Getopt::Long' => { - 'DISTRIBUTION' => 'JV/Getopt-Long-2.42.tar.gz', + 'DISTRIBUTION' => 'JV/Getopt-Long-2.43.tar.gz', 'FILES' => q[cpan/Getopt-Long], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/Getopt-Long/lib/Getopt/Long.pm b/cpan/Getopt-Long/lib/Getopt/Long.pm index 3ef7d99..0be46fe 100644 --- a/cpan/Getopt-Long/lib/Getopt/Long.pm +++ b/cpan/Getopt-Long/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: Wed Jan 14 15:03:41 2015 +# Update Count : 1680 # Status : Released ################ Module Preamble ################ @@ -17,10 +17,10 @@ use 5.004; use strict; use vars qw($VERSION); -$VERSION = 2.42; +$VERSION = 2.43; # For testing versions only. use vars qw($VERSION_STRING); -$VERSION_STRING = "2.42"; +$VERSION_STRING = "2.43"; 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,", @@ -365,6 +373,9 @@ sub GetOptionsFromArray(@) { next; } $linkage{'<>'} = shift (@optionlist); + if ( $passthrough ) { + $error .= "Option spec <> cannot be used with pass_through\n"; + } next; } @@ -458,6 +469,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 +721,7 @@ sub GetOptionsFromArray(@) { elsif ( $order == $PERMUTE ) { # Try non-options call-back. my $cb; - if ( (defined ($cb = $linkage{'<>'})) ) { + if ( !$passthrough && (defined ($cb = $linkage{'<>'})) ) { print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n") if $debug; my $eval_error = do { @@ -942,7 +956,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 +967,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 +1089,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 +1318,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 +1357,7 @@ sub Configure (@) { $getopt_compat = 0; $genprefix = "(--|-)"; $order = $PERMUTE; + $bundling_values = 0; } } elsif ( $try eq 'gnu_compat' ) { @@ -1344,9 +1377,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 +2173,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 +2189,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 +2211,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,8 +2449,8 @@ 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 +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 remaining options to some other program. @@ -2412,6 +2462,9 @@ 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 @@ -2673,7 +2726,7 @@ Johan Vromans <[email protected]> =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 -- Perl5 Master Repository
