newer Getopt/Long.pm from public distribution cited in:

	Message-Id: <m2n2bgm8en.fsf@phoenix.squirrel.nl>
	Subject: Getopt::Long version 2.17 released

p4raw-id: //depot/perl@1133

1 files changed, 269 insertions, 198 deletions

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index fe7e12f09b..b5804597ce 100644
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,12 +2,12 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.16 1998-03-13 11:05:29+01 jv Exp $
+# RCS Status      : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Fri Mar 13 11:05:28 1998
-# Update Count    : 659
+# Last Modified On: Sun Jun 14 13:17:22 1998
+# Update Count    : 705
 # Status          : Released
 
 ################ Copyright ################
@@ -34,71 +34,123 @@ use strict;
 BEGIN {
     require 5.004;
     use Exporter ();
-    use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-    $VERSION   = sprintf("%d.%02d", q$Revision: 2.16 $ =~ /(\d+)\.(\d+)/);
-
-    @ISA       = qw(Exporter);
-    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
-    %EXPORT_TAGS = ();
-    @EXPORT_OK = qw();
+    use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+#   $VERSION     = sprintf("%d.%02d", q$Revision: 2.18 $ =~ /(\d+)\.(\d+)/);
+    $VERSION     = "2.17";
+
+    @ISA         = qw(Exporter);
+    @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    %EXPORT_TAGS = qw();
+    @EXPORT_OK   = qw();
+    use AutoLoader qw(AUTOLOAD);
 }
 
-use vars @EXPORT, @EXPORT_OK;
 # User visible variables.
+use vars @EXPORT, @EXPORT_OK;
 use vars qw($error $debug $major_version $minor_version);
 # Deprecated visible variables.
 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
 	    $passthrough);
+# Official invisible variables.
+use vars qw($genprefix);
+
+# Public subroutines. 
+sub Configure (@);
+sub config (@);			# deprecated name
+sub GetOptions;
+
+# Private subroutines. 
+sub ConfigDefaults ();
+sub FindOption ($$$$$$$);
+sub Croak (@);			# demand loading the real Croak
 
 ################ Local Variables ################
 
-my $gen_prefix;			# generic prefix (option starters)
-my $argend;			# option list terminator
-my %opctl;			# table of arg.specs (long and abbrevs)
-my %bopctl;			# table of arg.specs (bundles)
-my @opctl;			# the possible long option names
-my $pkg;			# current context. Needed if no linkage.
-my %aliases;			# alias table
-my $genprefix;			# so we can call the same module more 
-my $opt;			# current option
-my $arg;			# current option value, if any
-my $array;			# current option is array typed
-my $hash;			# current option is hash typed
-my $key;			# hash key for a hash option
-				# than once in differing environments
-my $config_defaults;		# set config defaults
-my $find_option;		# helper routine
-my $croak;			# helper routine
-
-################ Subroutines ################
+################ Resident subroutines ################
+
+sub ConfigDefaults () {
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$genprefix = "(--|-)";
+	$autoabbrev = 0;		# no automatic abbrev of options
+	$bundling = 0;			# no bundling of single letter switches
+	$getopt_compat = 0;		# disallow '+' to start options
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$genprefix = "(--|-|\\+)";
+	$autoabbrev = 1;		# automatic abbrev of options
+	$bundling = 0;			# bundling off by default
+	$getopt_compat = 1;		# allow '+' to start options
+	$order = $PERMUTE;
+    }
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $error = 0;			# error tally
+    $ignorecase = 1;		# ignore case when matching options
+    $passthrough = 0;		# leave unrecognized options alone
+}
+
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+# Set defaults.
+ConfigDefaults ();
+
+################ Package return ################
+
+1;
+
+__END__
+
+################ AutoLoading subroutines ################
+
+# RCS Status      : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $
+# Author          : Johan Vromans
+# Created On      : Fri Mar 27 11:50:30 1998
+# Last Modified By: Johan Vromans
+# Last Modified On: Sun Jun 14 13:54:35 1998
+# Update Count    : 24
+# Status          : Released
 
 sub GetOptions {
 
     my @optionlist = @_;	# local copy of the option descriptions
-    $argend = '--';		# option list terminator
-    %opctl = ();		# table of arg.specs (long and abbrevs)
-    %bopctl = ();		# table of arg.specs (bundles)
-    $pkg = (caller)[0];		# current context
+    my $argend = '--';		# option list terminator
+    my %opctl = ();		# table of arg.specs (long and abbrevs)
+    my %bopctl = ();		# table of arg.specs (bundles)
+    my $pkg = (caller)[0];	# current context
 				# Needed if linkage is omitted.
-    %aliases= ();		# alias table
+    my %aliases= ();		# alias table
     my @ret = ();		# accum for non-options
     my %linkage;		# linkage
     my $userlinkage;		# user supplied HASH
-    $genprefix = $gen_prefix;	# so we can call the same module many times
+    my $opt;			# current option
+    my $genprefix = $genprefix;	# so we can call the same module many times
+    my @opctl;			# the possible long option names
+
     $error = '';
 
-    print STDERR ('GetOptions $Revision: 2.16 $ ',
-		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
-		  "called from package \"$pkg\".\n",
-		  "  (@ARGV)\n",
-		  "  autoabbrev=$autoabbrev".
-		  ",bundling=$bundling",
-		  ",getopt_compat=$getopt_compat",
-		  ",order=$order",
-		  ",\n  ignorecase=$ignorecase",
-		  ",passthrough=$passthrough",
-		  ",genprefix=\"$genprefix\"",
-		  ".\n")
+    print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
+		  "called from package \"$pkg\".",
+		  "\n  ",
+		  'GetOptionsAl $Revision: 2.20 $ ',
+		  "\n  ",
+		  "ARGV: (@ARGV)",
+		  "\n  ",
+		  "autoabbrev=$autoabbrev,".
+		  "bundling=$bundling,",
+		  "getopt_compat=$getopt_compat,",
+		  "order=$order,",
+		  "\n  ",
+		  "ignorecase=$ignorecase,",
+		  "passthrough=$passthrough,",
+		  "genprefix=\"$genprefix\".",
+		  "\n")
 	if $debug;
 
     # Check for ref HASH as first argument. 
@@ -146,7 +198,7 @@ sub GetOptions {
 	}
 
 	# Match option spec. Allow '?' as an alias.
-	if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?(!|[=:][infse][@%]?)?$/ ) {
+	if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
 	    $error .= "Error in option spec: \"$opt\"\n";
 	    next;
 	}
@@ -293,8 +345,6 @@ sub GetOptions {
 	#### Get next argument ####
 
 	$opt = shift (@ARGV);
-	$arg = undef;
-	$array = $hash = 0;
 	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
 
 	#### Determine what we have ####
@@ -308,11 +358,19 @@ sub GetOptions {
 	}
 
 	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
+
+	($found, $opt, $arg, $dsttype, $incr, $key) = 
+	  FindOption ($genprefix, $argend, $opt, 
+		      \%opctl, \%bopctl, \@opctl, \%aliases);
 
-	# find_option operates on the GLOBAL $opt and $arg!
-	if ( &$find_option () ) {
+	if ( $found ) {
 	    
-	    # find_option undefines $opt in case of errors.
+	    # FindOption undefines $opt in case of errors.
 	    next unless defined $opt;
 
 	    if ( defined $arg ) {
@@ -323,8 +381,21 @@ sub GetOptions {
 				  ref($linkage{$opt}), "\n") if $debug;
 
 		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
-			print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug;
-			${$linkage{$opt}} = $arg;
+			if ( $incr ) {
+			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
+			      if $debug;
+			    if ( defined ${$linkage{$opt}} ) {
+			        ${$linkage{$opt}} += $arg;
+			    }
+		            else {
+			        ${$linkage{$opt}} = $arg;
+			    }
+			}
+			else {
+			    print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
+			      if $debug;
+			    ${$linkage{$opt}} = $arg;
+		        }
 		    }
 		    elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
 			print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
@@ -344,11 +415,11 @@ sub GetOptions {
 		    else {
 			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
 				      "\" in linkage\n");
-			&$croak ("Getopt::Long -- internal error!\n");
+			Croak ("Getopt::Long -- internal error!\n");
 		    }
 		}
 		# No entry in linkage means entry in userlinkage.
-		elsif ( $array ) {
+		elsif ( $dsttype eq '@' ) {
 		    if ( defined $userlinkage->{$opt} ) {
 			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
 			    if $debug;
@@ -360,7 +431,7 @@ sub GetOptions {
 			$userlinkage->{$opt} = [$arg];
 		    }
 		}
-		elsif ( $hash ) {
+		elsif ( $dsttype eq '%' ) {
 		    if ( defined $userlinkage->{$opt} ) {
 			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
 			    if $debug;
@@ -373,8 +444,20 @@ sub GetOptions {
 		    }
 		}
 		else {
-		    print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
-		    $userlinkage->{$opt} = $arg;
+		    if ( $incr ) {
+			print STDERR ("=> \$L{$opt} += \"$arg\"\n")
+			  if $debug;
+			if ( defined $userlinkage->{$opt} ) {
+			    $userlinkage->{$opt} += $arg;
+			}
+			else {
+			    $userlinkage->{$opt} = $arg;
+			}
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+			$userlinkage->{$opt} = $arg;
+		    }
 		}
 	    }
 	}
@@ -414,84 +497,19 @@ sub GetOptions {
     return ($error == 0);
 }
 
-sub config (@) {
-    my (@options) = @_;
-    my $opt;
-    foreach $opt ( @options ) {
-	my $try = lc ($opt);
-	my $action = 1;
-	if ( $try =~ /^no_?(.*)$/s ) {
-	    $action = 0;
-	    $try = $+;
-	}
-	if ( $try eq 'default' or $try eq 'defaults' ) {
-	    &$config_defaults () if $action;
-	}
-	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
-	    $autoabbrev = $action;
-	}
-	elsif ( $try eq 'getopt_compat' ) {
-	    $getopt_compat = $action;
-	}
-	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
-	    $ignorecase = $action;
-	}
-	elsif ( $try eq 'ignore_case_always' ) {
-	    $ignorecase = $action ? 2 : 0;
-	}
-	elsif ( $try eq 'bundling' ) {
-	    $bundling = $action;
-	}
-	elsif ( $try eq 'bundling_override' ) {
-	    $bundling = $action ? 2 : 0;
-	}
-	elsif ( $try eq 'require_order' ) {
-	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
-	}
-	elsif ( $try eq 'permute' ) {
-	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
-	}
-	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
-	    $passthrough = $action;
-	}
-	elsif ( $try =~ /^prefix=(.+)$/ ) {
-	    $gen_prefix = $1;
-	    # Turn into regexp. Needs to be parenthesized!
-	    $gen_prefix = "(" . quotemeta($gen_prefix) . ")";
-	    eval { '' =~ /$gen_prefix/; };
-	    &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
-	}
-	elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
-	    $gen_prefix = $1;
-	    # Parenthesize if needed.
-	    $gen_prefix = "(" . $gen_prefix . ")" 
-	      unless $gen_prefix =~ /^\(.*\)$/;
-	    eval { '' =~ /$gen_prefix/; };
-	    &$croak ("Getopt::Long: invalid pattern \"$gen_prefix\"") if $@;
-	}
-	elsif ( $try eq 'debug' ) {
-	    $debug = $action;
-	}
-	else {
-	    &$croak ("Getopt::Long: unknown config parameter \"$opt\"")
-	}
-    }
-}
-
-# To prevent Carp from being loaded unnecessarily.
-$croak = sub {
-    require 'Carp.pm';
-    $Carp::CarpLevel = 1;
-    Carp::croak(@_);
-};
+# Option lookup.
+sub FindOption ($$$$$$$) {
 
-################ Private Subroutines ################
+    # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
+    # returns (0) otherwise.
 
-$find_option = sub {
+    my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
+    my $key;			# hash key for a hash option
+    my $arg;
 
-    print STDERR ("=> find \"$opt\", genprefix=\"$genprefix\"\n") if $debug;
+    print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
 
-    return 0 unless $opt =~ /^$genprefix(.*)$/s;
+    return (0) unless $opt =~ /^$prefix(.*)$/s;
 
     $opt = $+;
     my ($starter) = $1;
@@ -513,8 +531,10 @@ $find_option = sub {
     #### Look it up ###
 
     my $tryopt = $opt;		# option to try
-    my $optbl = \%opctl;	# table to look it up (long names)
+    my $optbl = $opctl;		# table to look it up (long names)
     my $type;
+    my $dsttype = '';
+    my $incr = 0;
 
     if ( $bundling && $starter eq '-' ) {
 	# Unbundle single letter option.
@@ -524,11 +544,11 @@ $find_option = sub {
 	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
+	$optbl = $bopctl;	# look it up in the short names table
 
 	# If bundling == 2, long options can override bundles.
 	if ( $bundling == 2 and
-	     defined ($type = $opctl{$tryopt.$rest}) ) {
+	     defined ($type = $opctl->{$tryopt.$rest}) ) {
 	    print STDERR ("=> $starter$tryopt rebundled to ",
 			  "$starter$tryopt$rest\n") if $debug;
 	    $tryopt .= $rest;
@@ -543,26 +563,26 @@ $find_option = sub {
 	# Turn option name into pattern.
 	my $pat = quotemeta ($opt);
 	# Look up in option names.
-	my @hits = grep (/^$pat/, @opctl);
+	my @hits = grep (/^$pat/, @{$names});
 	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
-		      "out of ", scalar(@opctl), "\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{$_};
+		$_ = $aliases->{$_} if defined $aliases->{$_};
 		$hit{$_} = 1;
 	    }
 	    # Now see if it really is ambiguous.
 	    unless ( keys(%hit) == 1 ) {
-		return 0 if $passthrough;
+		return (0) if $passthrough;
 		warn ("Option ", $opt, " is ambiguous (",
 		      join(", ", @hits), ")\n");
 		$error++;
 		undef $opt;
-		return 1;
+		return (1, $opt,$arg,$dsttype,$incr,$key);
 	    }
 	    @hits = keys(%hit);
 	}
@@ -584,10 +604,10 @@ $find_option = sub {
     # Check validity by fetching the info.
     $type = $optbl->{$tryopt} unless defined $type;
     unless  ( defined $type ) {
-	return 0 if $passthrough;
+	return (0) if $passthrough;
 	warn ("Unknown option: ", $opt, "\n");
 	$error++;
-	return 1;
+	return (1, $opt,$arg,$dsttype,$incr,$key);
     }
     # Apparently valid.
     $opt = $tryopt;
@@ -596,34 +616,35 @@ $find_option = sub {
     #### Determine argument status ####
 
     # If it is an option w/o argument, we're almost finished with it.
-    if ( $type eq '' || $type eq '!' ) {
+    if ( $type eq '' || $type eq '!' || $type eq '+' ) {
 	if ( defined $optarg ) {
-	    return 0 if $passthrough;
+	    return (0) if $passthrough;
 	    warn ("Option ", $opt, " does not take an argument\n");
 	    $error++;
 	    undef $opt;
 	}
-	elsif ( $type eq '' ) {
+	elsif ( $type eq '' || $type eq '+' ) {
 	    $arg = 1;		# supply explicit value
+	    $incr = $type eq '+';
 	}
 	else {
 	    substr ($opt, 0, 2) = ''; # strip NO prefix
 	    $arg = 0;		# supply explicit value
 	}
 	unshift (@ARGV, $starter.$rest) if defined $rest;
-	return 1;
+	return (1, $opt,$arg,$dsttype,$incr,$key);
     }
 
     # Get mandatory status and type info.
     my $mand;
-    ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+    ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
 
     # 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 "=" ) {
-	    return 0 if $passthrough;
+	    return (0) if $passthrough;
 	    warn ("Option ", $opt, " requires an argument\n");
 	    $error++;
 	    undef $opt;
@@ -631,7 +652,7 @@ $find_option = sub {
 	if ( $mand eq ":" ) {
 	    $arg = $type eq "s" ? '' : 0;
 	}
-	return 1;
+	return (1, $opt,$arg,$dsttype,$incr,$key);
     }
 
     # Get (possibly optional) argument.
@@ -640,7 +661,7 @@ $find_option = sub {
 
     # Get key if this is a "name=value" pair for a hash option.
     $key = undef;
-    if ($hash && defined $arg) {
+    if ($dsttype eq '%' && defined $arg) {
 	($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
     }
 
@@ -648,15 +669,16 @@ $find_option = sub {
 
     if ( $type eq "s" ) {	# string
 	# A mandatory string takes anything. 
-	return 1 if $mand eq "=";
+	return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
 
 	# An optional string takes almost anything. 
-	return 1 if defined $optarg || defined $rest;
-	return 1 if $arg eq "-"; # ??
+	return (1, $opt,$arg,$dsttype,$incr,$key) 
+	  if defined $optarg || defined $rest;
+	return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
 
 	# Check for option or option list terminator.
 	if ($arg eq $argend ||
-	    $arg =~ /^$genprefix.+/) {
+	    $arg =~ /^$prefix.+/) {
 	    # Push back.
 	    unshift (@ARGV, $arg);
 	    # Supply empty value.
@@ -675,7 +697,7 @@ $find_option = sub {
 		if ( $passthrough ) {
 		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 		      unless defined $optarg;
-		    return 0;
+		    return (0);
 		}
 		warn ("Value \"", $arg, "\" invalid for option ",
 		      $opt, " (number expected)\n");
@@ -708,7 +730,7 @@ $find_option = sub {
 		if ( $passthrough ) {
 		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 		      unless defined $optarg;
-		    return 0;
+		    return (0);
 		}
 		warn ("Value \"", $arg, "\" invalid for option ",
 		      $opt, " (real number expected)\n");
@@ -726,49 +748,89 @@ $find_option = sub {
 	}
     }
     else {
-	&$croak ("GetOpt::Long internal error (Can't happen)\n");
+	Croak ("GetOpt::Long internal error (Can't happen)\n");
     }
-    return 1;
-};
+    return (1, $opt, $arg, $dsttype, $incr, $key);
+}
 
-$config_defaults = sub {
-    # Handle POSIX compliancy.
-    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
-	$gen_prefix = "(--|-)";
-	$autoabbrev = 0;		# no automatic abbrev of options
-	$bundling = 0;			# no bundling of single letter switches
-	$getopt_compat = 0;		# disallow '+' to start options
-	$order = $REQUIRE_ORDER;
-    }
-    else {
-	$gen_prefix = "(--|-|\\+)";
-	$autoabbrev = 1;		# automatic abbrev of options
-	$bundling = 0;			# bundling off by default
-	$getopt_compat = 1;		# allow '+' to start options
-	$order = $PERMUTE;
+# Getopt::Long Configuration.
+sub Configure (@) {
+    my (@options) = @_;
+    my $opt;
+    foreach $opt ( @options ) {
+	my $try = lc ($opt);
+	my $action = 1;
+	if ( $try =~ /^no_?(.*)$/s ) {
+	    $action = 0;
+	    $try = $+;
+	}
+	if ( $try eq 'default' or $try eq 'defaults' ) {
+	    ConfigDefaults () if $action;
+	}
+	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+	    $autoabbrev = $action;
+	}
+	elsif ( $try eq 'getopt_compat' ) {
+	    $getopt_compat = $action;
+	}
+	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+	    $ignorecase = $action;
+	}
+	elsif ( $try eq 'ignore_case_always' ) {
+	    $ignorecase = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'bundling' ) {
+	    $bundling = $action;
+	}
+	elsif ( $try eq 'bundling_override' ) {
+	    $bundling = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'require_order' ) {
+	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+	}
+	elsif ( $try eq 'permute' ) {
+	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+	}
+	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+	    $passthrough = $action;
+	}
+	elsif ( $try =~ /^prefix=(.+)$/ ) {
+	    $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=(.+)$/ ) {
+	    $genprefix = $1;
+	    # Parenthesize if needed.
+	    $genprefix = "(" . $genprefix . ")" 
+	      unless $genprefix =~ /^\(.*\)$/;
+	    eval { '' =~ /$genprefix/; };
+	    Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+	}
+	elsif ( $try eq 'debug' ) {
+	    $debug = $action;
+	}
+	else {
+	    Croak ("Getopt::Long: unknown config parameter \"$opt\"")
+	}
     }
-    # Other configurable settings.
-    $debug = 0;			# for debugging
-    $error = 0;			# error tally
-    $ignorecase = 1;		# ignore case when matching options
-    $passthrough = 0;		# leave unrecognized options alone
-};
-
-################ Initialization ################
-
-# Values for $order. See GNU getopt.c for details.
-($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
-# Version major/minor numbers.
-($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
-
-# Set defaults.
-&$config_defaults ();
+}
 
-################ Package return ################
+# Deprecated name.
+sub config (@) {
+    Configure (@_);
+}
 
-1;
+# To prevent Carp from being loaded unnecessarily.
+sub Croak (@) {
+    require 'Carp.pm';
+    $Carp::CarpLevel = 1;
+    Carp::croak(@_);
+};
 
-__END__
+################ Documentation ################
 
 =head1 NAME
 
@@ -848,6 +910,15 @@ Option does not take an argument and may be negated, i.e. prefixed by
 (with value 0).
 The option variable will be set to 1, or 0 if negated.
 
+=item +
+
+Option does not take an argument and will be incremented by 1 every
+time it appears on the command line. E.g. "more+", when used with
+B<--more --more --more>, will set the option variable to 3 (provided
+it was 0 or undefined at first).
+
+The B<+> specifier is ignored if the option destination is not a SCALAR.
+
 =item =s
 
 Option takes a mandatory string argument.
@@ -959,7 +1030,7 @@ Note that, if your code is running under the recommended C<use strict
 'vars'> pragma, it may be helpful to declare these package variables
 via C<use vars> perhaps something like this:
 
-    use vars qw/ $opt_size @opt_sizes $opt_bar /;
+  use vars qw/ $opt_size @opt_sizes $opt_bar /;
 
 If a REF SCALAR is supplied, the new value is stored in the referenced
 variable. If the option occurs more than once, the previous value is
@@ -1112,7 +1183,7 @@ This will leave the non-options in @ARGV:
 =head1 CONFIGURATION OPTIONS
 
 B<GetOptions> can be configured by calling subroutine
-B<Getopt::Long::config>. This subroutine takes a list of quoted
+B<Getopt::Long::Configure>. This subroutine takes a list of quoted
 strings, each specifying a configuration option to be set, e.g.
 B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
 B<no_ignore_case>. Case does not matter. Multiple calls to B<config>