Move Getopt::Long from ext/ to cpan/

9 files changed, 3678 insertions, 0 deletions

diff --git a/cpan/Getopt-Long/CHANGES b/cpan/Getopt-Long/CHANGES
new file mode 100644
index 0000000000..679da2abae
--- /dev/null
+++ b/cpan/Getopt-Long/CHANGES
@@ -0,0 +1,534 @@
+Changes in version 2.38
+-----------------------
+
+* Bugfix for Ticket 35759: First arg to callback function evaluates
+  to false when used in bool context.
+
+* Fix problem with prototypes of GetOptionsFrom* functions.
+
+* Fix restoring default die handler.
+
+* Bugfix for Ticket 24941: Autoabbrev with + incorrect.
+
+Changes in version 2.37
+-----------------------
+
+* The first argument to callback function is now an object and will
+  get methods for finer control in the future. The object stringifies
+  to the option name, so current code should not notice a difference.
+
+* Bugfix: With gnu_compat, --foo= will no longer trigger "Option
+  requires an argument" but return the empty string.
+
+Changes in version 2.36
+-----------------------
+
+**************** WARNING -- EXPERIMENTAL CODE AHEAD ****************
+
+* Parsing options from an arbitrary array
+
+  The entry point GetOptionsFromArray (exported on demand) can be used
+  to parse command line options that are not passed in via @ARGV, but
+  using an arbitrary array.
+
+    use Getopt::Long qw(GetOptionsFromArray);
+    $ret = GetOptionsFromArray(\@myopts, ...);
+
+* Parsing options from an arbitrary string
+
+  The entry point GetOptionsFromString (exported on demand) can be
+  used to parse command line options that are not passed in via @ARGV,
+  but using an arbitrary string.
+
+    use Getopt::Long qw(GetOptionsFromString);
+    $ret = GetOptionsFromString($optstring, ...);
+
+  Note that upon completion, no arguments may remain in the string.
+  If arguments may remain, call it in list context:
+
+    ($ret, $args) = GetOptionsFromString($optstring, ...);
+
+  @$args will have the remaining arguments.
+
+**************** END EXPERIMENTAL CODE ****************
+
+* Number values for options may include underscores for readability
+  (just like Perls numbers).
+
+* Bugfix for Ticket #19432 (found and fixed by khali).
+
+* Bugfix to make it cooperate with the bignum pragma. Thanks to Merijn
+  and Yves.
+
+* Various small fixes to make the test suite run under 5.004_05.
+
+* More examples (skeletons).
+
+Changes in version 2.35
+-----------------------
+
+* long_prefix_pattern configuration variable.
+
+  prefix_pattern has now been complemented by a new configuration
+  option 'long_prefix_pattern' that allows the user to specify what
+  prefix patterns should have long option style sematics applied.
+  This will enable people to do things like
+
+    foo.pl /option=value
+
+  instead of forcing people to use the short option style
+
+    foo.pl /option value
+
+  This enhancement was suggested and implemented by Yves Orton.
+
+* Bugfix for Ticket #11377 (bug found and fixed by Ryan).
+* Bugfix for Ticket #12380.
+
+* Options can take multiple values at once. E.g.,
+
+    --coordinates 52.2 16.4 --rgbcolor 255 255 149
+
+  To handle the above command line, the following call to GetOptions
+  can be used:
+
+    GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
+
+  You can specify the minimum and maximum number of values desired.
+  The syntax for this is similar to that of regular expression
+  patterns: { min , max }. 
+
+Changes in version 2.34
+-----------------------
+
+* Auto-vivification of array and hash refs
+
+  If an option is specified to require an array or hash ref, and a
+  scalar reference is passed, this is auto-vivified to array or hash
+  ref. 
+
+  Example:
+
+	@ARGV = qw(--foo=xx);
+	GetOptions("foo=s@", \$var);
+	# Now $var->[0] eq "xx"
+
+* Auto-supplied verbose and help options are no longer taken into
+  account when determining option ambiguity. This eliminates the
+  common problem that you suddenly get an ambiguous option warning
+  when you have an option "verbose" and run your program with "-v".
+
+* Cosmetic changes in some error messages.
+
+Changes in version 2.33
+-----------------------
+
+The following new features are marked experimental. This means that if
+you are going to use them you _must_ watch out for the next release of
+Getopt::Long to see if the API has changed.
+
+* Getopt::Long can automatically handle --version and --help options
+  if the calling program did not specify a handler explicitly.
+
+  Two configuration parameters have been added: 'auto_help' (or
+  'help') and 'auto_version' (or 'version'). If set, Getopt::Long will
+  itself take care of --help and --version options. Otherwise,
+  everything is exactly as it was before.
+
+  The new features will be enabled by default for programs that
+  explicitly require version 2.3203 or later.
+
+  Getopt::Long uses module Pod::Usage to produce the help message from
+  the SYNOPSIS section of the program's POD.
+
+  Using a --help (or -?) command line option will write the SYNOPSIS
+  section of the program's POD to STDOUT, and exit with status 0.
+  However, an illegal option will produce the help text to STDERR,
+  and exit with status 2. This is in accordance with current
+  conventions.
+
+* Two subroutines can be exported on demand:
+
+  - VersionMessage
+
+    This subroutine prints the standard version message.
+
+  - HelpMessage
+
+    This subroutine prints the standard help message.
+
+  Both subroutines take the same arguments as Pod::Usage::pod2usage,
+  see its documentation for details.  
+
+  Example:
+
+    use Getopt::Long 2.33 qw(GetOptions HelpMessage);
+    GetOptions(...) or HelpMessage(2);
+
+* Subroutine Configure can now be exported on demand.
+
+* Negatable options (with "!") now also support the "no-" prefix.
+  On request of Ed Avis.
+
+* Some fixes with hashes and bundling.
+  Thanks to Anders Johnson and Andrei Gnepp.
+  Mandatory/optional status for hash values is now effective.
+  String valued options with no value now default to the empty string
+  instead of 1 (one).
+  NOTE: The hash options still remain more or less experimental.
+
+* Fix a pass_through bug where the options terminator (normally "--")
+  was not passed through in @ARGV.
+  Thanks to Philippe Verdret.
+
+* Add FAQ: I "use GetOpt::Long;" (Windows) and now it doesn't work.
+
+Changes in version 2.32
+-----------------------
+
+* Fix a bug where the initial value for a optional numeric argument
+was not used for value of a hash option.
+
+* Remove 5.005 thread safety code. Getopt::Long is completely thread
+safe when using the 5.8 ithreads.
+
+Changes in version 2.31
+-----------------------
+
+* Fix a bug where calling the configure method on a
+  Getopt::Long::Parser object would bail out with 
+  Undefined subroutine &Getopt::Long::Parser::Configure called at
+  Getopt/Long.pm line 186.
+
+Changes in version 2.30
+-----------------------
+
+* Fix a problem where a 'die' from a 'warn' via a localized
+  $SIG{__WARN__} was not properly propagated from a callback.
+  Thanks to Diab Jerius.
+
+Changes in version 2.29
+-----------------------
+
+* Fix a problem where options were not recognized when both
+  auto_abbrev and ignore_case were disabled. Thanks to Seth Robertson.
+
+* Remove Carp.
+
+Changes in version 2.28
+-----------------------
+
+* When an option is specified more than once, a warning is generated
+  if perl is run with -w. This is a correction to 2.27, where it would
+  unconditionally die.
+
+  An example of duplicate specification is GetOptions('foo', 'foo'),
+  but also GetOptions('foo=s', 'foo') and GetOptions('Foo', 'foo')
+  (the latter only when ignore_case is in effect).
+
+Changes in version 2.27
+-----------------------
+
+* You can now specify integer options to take an optional argument.
+  that defaults to a specific value. E.g.,  GetOptions('foo:5' => \$var)
+  will allow $var to get the value 5 when no value was specified with
+  the -foo option on the command line.
+
+  Instead of a value, a '+' may be specified. E.g.,
+  GetOptions('foo:+' => \$var) will allow $var to be incremented when
+  no value was specified with the -foo option on the command line.
+
+* Fix several problems with internal and external use of 'die' and
+  signal handlers.
+
+* Fixed some bugs with subtle combinations of bundling_override and
+  ignore_case.
+
+* A callback routine that is associated with a hash-valued option will
+  now have both the hask key and the value passed. It used to get only
+  the value passed.
+
+* Eliminated the use of autoloading. Autoloading kept generating
+  problems during development, and when using perlcc.
+
+* Avoid errors on references when an option is found in error, e.g.
+  GetOptions('fo$@#' => \$var).
+  Thanks to Wolfgang Laun.
+
+* When an option is specified more than once, an error is now
+  generated. E.g., GetOptions('foo', 'foo').
+  Thanks to Wolfgang Laun.
+
+* Lots of internal restructoring to make room for extensions.
+
+* Redesigned the regression tests.
+
+* Enhance the documentation to prevent common misunderstandings about
+  single character options.
+
+Changes in version 2.26
+-----------------------
+
+* New option type: 'o'. It accepts all kinds of integral numbers in
+  Perl style, including decimal (24), octal (012), hexadecimal (0x2f)
+  and binary (0b1001).
+
+* Fix problem with getopt_compat not matching +foo=bar.
+
+* Remove $VERSION_STRING for production versions.
+
+Changes in version 2.25
+-----------------------
+
+* Change handling of a lone "-" on the command line. It will now be
+  treated as a non-option unless an explicit specification was passed
+  to GetOptions. See the manual.
+  In the old implementation an error was signalled, so no
+  compatibility breaks are expected from this change.
+
+* Add $VERSION_STRING. This is the string form of $VERSION. Usually
+  they are identical, unless it is a pre-release in which case
+  $VERSION will be (e.g.) 2.2403 and $VERSION_STRING will be "2.24_03".
+
+Changes in version 2.24
+-----------------------
+
+* Add object oriented interface:
+
+    use Getopt::Long;
+    $p = new Getopt::Long::Parser;
+    $p->configure(...configuration options...);
+    if ($p->getoptions(...options descriptions...)) ...
+
+* Add configuration at 'use' time:
+
+    use Getopt::Long qw(:config no_ignore_case bundling);
+
+* Add configuration options "gnu_getopt" and "gnu_compat".
+
+  "gnu_compat" controls whether --opt= is allowed, and what it should
+  do. Without "gnu_compat", --opt= gives an error. With "gnu_compat", 
+  --opt= will give option "opt" and empty value.
+  This is the way GNU getopt_long does it.
+
+  "gnu_getopt" is a short way of setting "gnu_compat bundling permute
+  no_getopt_compat. With "gnu_getopt", command line handling should be
+  fully compatible with GNU getopt_long.
+
+* Correct warnings when the user specified an array or hash
+  destination using a non-lowercase option, e.g. "I=s@".
+
+* Correct ambiguous use of 'set' and 'reset' in the Configuration
+  section of the documentation. 
+
+* Add configuration option "posix_default" to reset to defaults as if
+  POSIXLY_CORRECT were set.
+
+* Disallow "no" prefix on configuration options "default", "prefix" and
+  "prefix_pattern". 
+
+* Add a section "Trouble Shooting" to the documentation, with
+  frequently asked questions.
+
+Changes in version 2.23
+-----------------------
+
+* When a call-back routine issues 'die', messages starting with "!"
+  are treated specially. Currently, only "!FINISH" is recognised (see
+  the next bullet point). Other messages that start with "!" are
+  ignored.
+
+* Change 'die("FINISH") (see changes in 2.21) to die("!FINISH"). This
+  is an incompatible change, but I guess noone is using this yet.
+
+Changes in version 2.22
+-----------------------
+
+* Fixes a bug in the combination of aliases and negation.
+
+  Old:  "foo|bar!" allowed negation on foo, but not on bar.
+  New:  "foo|bar!" allows negation on foo and bar.
+
+  Caveat: "foo|f!", with bundling, issues the warning that negation on
+  a short option is ignored. To obtain the desired behaviour, use
+
+	"foo!" => \$opt_foo, "f" => \$opt_foo
+  or
+	"foo|f" => \$opt_foo, "nofoo" => sub { $opt_foo = 0 }
+
+  Remember that this is _only_ required when bundling is in effect.
+
+Changes in version 2.21
+-----------------------
+
+* New documentation.
+
+* User defined subroutines should use 'die' to signal errors.
+
+* User defined subroutines can preliminary terminate options
+  processing by calling die("FINISH");
+
+* Correct erroneous install of Getopt::Long manpage.
+  Previous versions seem to install Getopt::GetoptLong instead of
+  Getopt::Long.
+
+Changes in version 2.20
+-----------------------
+
+* Prevent the magic argument "<>" from being interpreted as option
+  starter characters if it is the first argument passed.
+  To use the characters "<>" as option starters, pass "><" instead.
+
+* Changed license: Getopt::Long may now also be used under the Perl
+  Artistic License.
+
+* Changed the file name of the distribution kit from "GetoptLong..."
+  to "Getopt-Long-..." to match the standards.
+
+Changes in version 2.19
+-----------------------
+
+* Fix a warning bug with bundling_override.
+
+There's no version 2.18
+-----------------------
+
+Changes in version 2.17
+-----------------------
+
+* Getopt::Long::config is renamed Getopt::Long::Configure. The old
+  name will remain supported without being documented.
+
+* Options can have the specifier '+' to denote that the option value
+  must be incremented each time the option occurs on the command line.
+  For example:
+
+     my $more = 2;
+     Getopt::Long::Configure("bundling");
+     GetOptions ("v+" => \$more);
+     print STDOUT ("more = $more\n");
+
+  will print "more = 3" when called with "-v", "more = 4" when called
+  with "-vv" (or "-v -v"), and so on.
+
+* Getopt::Long now uses autoloading. This substantially reduces the
+  resources required to 'use Getopt::Long' (about 100 lines of over
+  1300 total).
+
+* It is now documented that global option variables like $opt_foo
+  need to be declared using 'use vars ...' when running under 'use
+  strict'. 
+
+* To install, it is now required to use the official procedure:
+
+     perl Makefile.PL
+     make
+     make test
+     make install
+
+Changes in version 2.16
+-----------------------
+
+* A couple of small additional fixes to the $` $& $' fixes.
+
+* The option prefix can be set using config("prefix=...") or, more
+  powerful, with config("prefix_pattern=..."); see the documentation
+  for details.
+
+* More 'perl -w' warnings eliminated for obscure cases of bundling.
+
+This version is identical to 2.15, which was not released.
+
+There's no version 2.14
+-----------------------
+
+Changes in version 2.13
+-----------------------
+
+* All regexps are changed to avoid the use of $`, $& and $'. Using one
+  of these causes all pattern matches in the program to be much slower
+  than necessary.
+
+* Configuration errors are signalled using die() and will cause the
+  program to be terminated (unless eval{...} or $SIG{__DIE__} is
+  used).
+
+* Option parsing errors are now signalled with calls to warn().
+
+* In option bundles, numeric values may be embedded in the bundle
+  (e.g. -al24w80).
+
+* More 'perl -w' warnings eliminated for obscure cases of bundling.
+
+* Removed non-standard version number matching. Version 1.121 is now
+  more than 1.12 but less than 1.13. 
+
+Changes in version 2.12
+-----------------------
+
+* A single question mark is allowed as an alias to an option, e.g. 
+
+    GetOptions ("help|?", ...)
+
+Changes in version 2.11
+-----------------------
+
+* User linkage may be an object, provided the object is really a hash.
+
+  For example:
+
+    {	package Foo;
+	sub new () { return bless {}; }
+    }
+
+    my $linkage = Foo->new();
+
+    GetOptions ($linkage, ... );
+
+* Some bug fixes in handling obscure cases of pass-through.
+
+Changes in version 2.9
+----------------------
+
+* A new way to configure Getopt::Long. Instead of setting module local
+  variables, routine Getopt::Long::config can be called with the names
+  of options to be set or reset, e.g.
+
+    Getopt::Long::config ("no_auto_abbrev", "ignore_case");
+
+  Configuring by using the module local variables is deprecated, but
+  it will continue to work for backwark compatibility.
+
+Changes in version 2.6
+----------------------
+
+* Handle ignorecase even if autoabbrev is off. 
+
+* POD corrections.
+
+Changes in version 2.4
+----------------------
+
+* Pass-through of unrecognized options. Makes it easy to write wrapper
+  programs that process some of the command line options but pass the
+  others to another program.
+
+* Options can be of type HASH, now you can say
+
+    --define foo=bar
+
+  and have $opt_define{"foo"} set to "bar".
+
+* An enhanced skeleton program, skel2.pl, that combines the power of
+  Getopt::Long with Pod::Usage. 
+  Module Pod::Usage can be obtained from CPAN,
+  http://www.perl.com/CPAN/authors/Brad_Appleton. 
+
+Possible incompatibility in version 2.4
+---------------------------------------
+
+Previous versions of Getopt::Long always downcased the option variable
+names when ignorecase was in effect. This bug has been corrected. As a
+consequence, &GetOptions ("Foo") will now set variable $opt_Foo
+instead of $opt_foo.
+
diff --git a/cpan/Getopt-Long/README b/cpan/Getopt-Long/README
new file mode 100644
index 0000000000..b1b8e2a8f4
--- /dev/null
+++ b/cpan/Getopt-Long/README
@@ -0,0 +1,214 @@
+Module Getopt::Long - extended processing of command line options
+=================================================================
+
+Module Getopt::Long implements an extended getopt function called
+GetOptions(). This function implements the POSIX standard for command
+line options, with GNU extensions, while still capable of handling
+the traditional one-letter options.
+In general, this means that command line options can have long names
+instead of single letters, and are introduced with a double dash `--'.
+
+Optionally, Getopt::Long can support the traditional bundling of
+single-letter command line options.
+
+Getopt::Long is part of the Perl 5 distribution. It is the successor
+of newgetopt.pl that came with Perl 4. It is fully upward compatible.
+In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
+the module.
+
+For complete documentation, see the Getopt::Long POD document or use
+the command
+
+    perldoc Getopt::Long
+
+FEATURES
+========
+
+* Long option names
+
+Major advantage of using long option names is that it is much easier
+to memorize the option names. Using single-letter names one quickly
+runs into the problem that there is no logical relationship between
+the semantics of the selected option and its option letter.
+Disadvantage is that it requires more typing. Getopt::Long provides
+for option name abbreviation, so option names may be abbreviated to
+uniqueness. Also, modern shells like Cornell's tcsh support option
+name completion. As a rule of thumb, you can use abbreviations freely
+while running commands interactively but always use the full names in
+scripts. 
+
+Examples (POSIX):
+
+    --long --width=80 --height=24
+
+Extensions:
+
+    -long (convenience) +width=80 (deprecated) -height 24 (traditional)
+
+By default, long option names are case insensitive.
+
+* Single-letter options and bundling
+
+When single-letter options are requested, Getopt::Long allows the
+option names to be bundled, e.g. "-abc" is equivalent to "-a -b -c".
+In this case, long option names must be introduced with the POSIX "--"
+introducer.
+
+Examples:
+
+    -lgAd (bundle) -xw 80 (bundle, w takes a value) -xw80 (same)
+    even -l24w80 (l = 24 and w = 80)
+
+By default, single-letter option names are case sensitive.
+
+* Flexibility:
+
+  - options can have alternative names, using an alternative name
+    will behave as if the primary name was used;
+  - options can be negatable, e.g. "debug" will switch it on, while
+    "nodebug" will switch it off.    
+  - options can set values, but also add values producing an array
+    of values instead of a single scalar value, or set values in a hash.
+  - options can have multiple values, e.g., "--position 25 624".
+
+* Options linkage
+
+Using Getopt::Long gives the programmer ultimate control over the
+command line options and how they must be handled:
+
+  - by setting a global variable in the calling program;
+  - by setting a specified variable;
+  - by entering the option name and the value in an associative array
+    (hash) or object (if it is a blessed hash);
+  - by calling a user-specified subroutine with the option name and
+    the value as arguments (for hash options: the name, key and value);
+  - combinations of the above.
+
+* Customization:
+
+The module can be customized by specifying settings in the 'use'
+directive, or by calling a special method, Getopt::Long::Configure.
+For example, the following two cases are functionally equal:
+
+    use Getopt::Long qw(:config bundling no_ignore_case);
+
+and
+
+    use Getopt::Long;
+    Getopt::Long::Configure qw(bundling no_ignore_case);
+    
+Some of the possible customizations. Most of them take a "no_" prefix
+to reverse the effect:
+
+  - default
+
+	Restore default settings.
+
+  - auto_abbrev      
+
+	Allow option names to be abbreviated to uniqueness. 
+
+  - getopt_compat   
+
+	Allow '+' to start options.
+
+  - gnu_compat
+
+	Compatibility with GNU getopt_long().
+
+  - permute
+  - require_order           
+
+	Whether non-options are allowed to be mixed with options.
+
+	permute means that 
+
+	    -foo arg1 -bar arg2 arg3
+
+	is equivalent to
+
+	    -foo -bar arg1 arg2 arg3
+
+	(provided -foo does not take an argument value).
+
+	require_order means that options processing
+	terminates when the first non-option is encountered.
+
+	    -foo arg1 -bar arg2 arg3
+
+	is equivalent to
+
+	    -foo -- arg1 -bar arg2 arg3
+
+  - bundling
+
+	Setting this variable to a non-zero value will allow 
+	single-character options to be bundled. To distinguish bundles
+	from long option names, long options must be introduced with 
+	"--" and single-character options (and bundles) with "-".
+
+  - ignore_case      
+
+	Ignore case when matching options.
+
+  - pass_through
+
+	Do not issue error messages for unknown options, but leave
+	them (pass-through) in @ARGV.
+
+  - prefix
+
+	The string that starts options. See also prefix_pattern.
+
+  - prefix_pattern
+
+	A Perl pattern that identifies the strings that introduce
+	options. Default is --|-|\+ unless environment variable
+	POSIXLY_CORRECT has been set, in which case it is --|-.
+
+  - long_prefix_pattern
+
+        A perl pattern that is used to identify which prefixes
+        should be treated as long style. Any prefixes that don't
+        match this pattern will have short option semantics.
+        Defaults to --.
+
+  - debug
+
+	Enable copious debugging output.
+
+* Object oriented interface:
+
+Using the object oriented interface, multiple parser objects can be
+instantiated, each having their own configuration settings:
+
+    $p1 = new Getopt::Long::Parser (config => ["bundling"]);
+    $p2 = new Getopt::Long::Parser (config => ["posix"]);
+    if ($p1->getoptions(...options descriptions...)) ...
+
+AVAILABILITY
+============
+
+The official version for module Getopt::Long comes with the Perl 5
+distribution. 
+Newer versions will be made available on the Comprehensive Perl Archive
+Network (CPAN), see "http://www.perl.com/CPAN/authors/Johan_Vromans".
+Or use the CPAN search engine:
+  http://search.cpan.org/search?mode=module&query=Getopt::Long
+  http://search.cpan.org/search?module=Getopt::Long
+
+COPYRIGHT AND DISCLAIMER
+========================
+
+Module Getopt::Long is Copyright 2009,1990 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
+Foundation; either version 2 of the License, or (at your option) any
+later version.
+
+-------------------------------------------------------------------
+Johan Vromans                                  jvromans@squirrel.nl
+Squirrel Consultancy                         Exloo, the Netherlands
+http://www.squirrel.nl       http://www.squirrel.nl/people/jvromans
+------------------ "Arms are made for hugging" --------------------
diff --git a/cpan/Getopt-Long/lib/Getopt/Long.pm b/cpan/Getopt-Long/lib/Getopt/Long.pm
new file mode 100644
index 0000000000..c827d3c39b
--- /dev/null
+++ b/cpan/Getopt-Long/lib/Getopt/Long.pm
@@ -0,0 +1,2649 @@
+# Getopt::Long.pm -- Universal options parsing
+
+package Getopt::Long;
+
+# RCS Status      : $Id: Long.pm,v 2.76 2009/03/30 20:54:30 jv Exp $
+# Author          : Johan Vromans
+# Created On      : Tue Sep 11 15:00:12 1990
+# Last Modified By: Johan Vromans
+# Last Modified On: Mon Mar 30 22:51:17 2009
+# Update Count    : 1601
+# Status          : Released
+
+################ Module Preamble ################
+
+use 5.004;
+
+use strict;
+
+use vars qw($VERSION);
+$VERSION        =  2.38;
+# For testing versions only.
+#use vars qw($VERSION_STRING);
+#$VERSION_STRING = "2.38";
+
+use Exporter;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+@ISA = qw(Exporter);
+
+# Exported subroutines.
+sub GetOptions(@);		# always
+sub GetOptionsFromArray(@);	# on demand
+sub GetOptionsFromString(@);	# on demand
+sub Configure(@);		# on demand
+sub HelpMessage(@);		# on demand
+sub VersionMessage(@);		# in demand
+
+BEGIN {
+    # Init immediately so their contents can be used in the 'use vars' below.
+    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
+		    &GetOptionsFromArray &GetOptionsFromString);
+}
+
+# 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 $caller $gnu_compat $auto_help $auto_version $longprefix);
+
+# Public subroutines.
+sub config(@);			# deprecated name
+
+# Private subroutines.
+sub ConfigDefaults();
+sub ParseOptionSpec($$);
+sub OptCtl($);
+sub FindOption($$$$$);
+sub ValidValue ($$$$$);
+
+################ Local Variables ################
+
+# $requested_version holds the version that was mentioned in the 'use'
+# or 'require', if any. It can be used to enable or disable specific
+# features.
+my $requested_version = 0;
+
+################ 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
+    $gnu_compat = 0;		# require --opt=val if value is optional
+    $longprefix = "(--)";       # what does a long prefix look like
+}
+
+# Override import.
+sub import {
+    my $pkg = shift;		# package
+    my @syms = ();		# symbols to import
+    my @config = ();		# configuration
+    my $dest = \@syms;		# symbols first
+    for ( @_ ) {
+	if ( $_ eq ':config' ) {
+	    $dest = \@config;	# config next
+	    next;
+	}
+	push(@$dest, $_);	# push
+    }
+    # Hide one level and call super.
+    local $Exporter::ExportLevel = 1;
+    push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
+    $pkg->SUPER::import(@syms);
+    # And configure.
+    Configure(@config) if @config;
+}
+
+################ 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+)/;
+
+ConfigDefaults();
+
+################ OO Interface ################
+
+package Getopt::Long::Parser;
+
+# Store a copy of the default configuration. Since ConfigDefaults has
+# just been called, what we get from Configure is the default.
+my $default_config = do {
+    Getopt::Long::Configure ()
+};
+
+sub new {
+    my $that = shift;
+    my $class = ref($that) || $that;
+    my %atts = @_;
+
+    # Register the callers package.
+    my $self = { caller_pkg => (caller)[0] };
+
+    bless ($self, $class);
+
+    # Process config attributes.
+    if ( defined $atts{config} ) {
+	my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
+	$self->{settings} = Getopt::Long::Configure ($save);
+	delete ($atts{config});
+    }
+    # Else use default config.
+    else {
+	$self->{settings} = $default_config;
+    }
+
+    if ( %atts ) {		# Oops
+	die(__PACKAGE__.": unhandled attributes: ".
+	    join(" ", sort(keys(%atts)))."\n");
+    }
+
+    $self;
+}
+
+sub configure {
+    my ($self) = shift;
+
+    # Restore settings, merge new settings in.
+    my $save = Getopt::Long::Configure ($self->{settings}, @_);
+
+    # Restore orig config and save the new config.
+    $self->{settings} = Getopt::Long::Configure ($save);
+}
+
+sub getoptions {
+    my ($self) = shift;
+
+    # Restore config settings.
+    my $save = Getopt::Long::Configure ($self->{settings});
+
+    # Call main routine.
+    my $ret = 0;
+    $Getopt::Long::caller = $self->{caller_pkg};
+
+    eval {
+	# Locally set exception handler to default, otherwise it will
+	# be called implicitly here, and again explicitly when we try
+	# to deliver the messages.
+	local ($SIG{__DIE__}) = 'DEFAULT';
+	$ret = Getopt::Long::GetOptions (@_);
+    };
+
+    # Restore saved settings.
+    Getopt::Long::Configure ($save);
+
+    # Handle errors and return value.
+    die ($@) if $@;
+    return $ret;
+}
+
+package Getopt::Long;
+
+################ Back to Normal ################
+
+# Indices in option control info.
+# Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
+use constant CTL_TYPE    => 0;
+#use constant   CTL_TYPE_FLAG   => '';
+#use constant   CTL_TYPE_NEG    => '!';
+#use constant   CTL_TYPE_INCR   => '+';
+#use constant   CTL_TYPE_INT    => 'i';
+#use constant   CTL_TYPE_INTINC => 'I';
+#use constant   CTL_TYPE_XINT   => 'o';
+#use constant   CTL_TYPE_FLOAT  => 'f';
+#use constant   CTL_TYPE_STRING => 's';
+
+use constant CTL_CNAME   => 1;
+
+use constant CTL_DEFAULT => 2;
+
+use constant CTL_DEST    => 3;
+ use constant   CTL_DEST_SCALAR => 0;
+ use constant   CTL_DEST_ARRAY  => 1;
+ use constant   CTL_DEST_HASH   => 2;
+ use constant   CTL_DEST_CODE   => 3;
+
+use constant CTL_AMIN    => 4;
+use constant CTL_AMAX    => 5;
+
+# FFU.
+#use constant CTL_RANGE   => ;
+#use constant CTL_REPEAT  => ;
+
+# Rather liberal patterns to match numbers.
+use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
+use constant PAT_XINT  =>
+  "(?:".
+	  "[-+]?_*[1-9][0-9_]*".
+  "|".
+	  "0x_*[0-9a-f][0-9a-f_]*".
+  "|".
+	  "0b_*[01][01_]*".
+  "|".
+	  "0[0-7_]*".
+  ")";
+use constant PAT_FLOAT => "[-+]?[0-9._]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
+
+sub GetOptions(@) {
+    # Shift in default array.
+    unshift(@_, \@ARGV);
+    # Try to keep caller() and Carp consitent.
+    goto &GetOptionsFromArray;
+}
+
+sub GetOptionsFromString(@) {
+    my ($string) = shift;
+    require Text::ParseWords;
+    my $args = [ Text::ParseWords::shellwords($string) ];
+    $caller ||= (caller)[0];	# current context
+    my $ret = GetOptionsFromArray($args, @_);
+    return ( $ret, $args ) if wantarray;
+    if ( @$args ) {
+	$ret = 0;
+	warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
+    }
+    $ret;
+}
+
+sub GetOptionsFromArray(@) {
+
+    my ($argv, @optionlist) = @_;	# local copy of the option descriptions
+    my $argend = '--';		# option list terminator
+    my %opctl = ();		# table of option specs
+    my $pkg = $caller || (caller)[0];	# current context
+				# Needed if linkage is omitted.
+    my @ret = ();		# accum for non-options
+    my %linkage;		# linkage
+    my $userlinkage;		# user supplied HASH
+    my $opt;			# current option
+    my $prefix = $genprefix;	# current prefix
+
+    $error = '';
+
+    if ( $debug ) {
+	# Avoid some warnings if debugging.
+	local ($^W) = 0;
+	print STDERR
+	  ("Getopt::Long $Getopt::Long::VERSION (",
+	   '$Revision: 2.76 $', ") ",
+	   "called from package \"$pkg\".",
+	   "\n  ",
+	   "argv: (@$argv)",
+	   "\n  ",
+	   "autoabbrev=$autoabbrev,".
+	   "bundling=$bundling,",
+	   "getopt_compat=$getopt_compat,",
+	   "gnu_compat=$gnu_compat,",
+	   "order=$order,",
+	   "\n  ",
+	   "ignorecase=$ignorecase,",
+	   "requested_version=$requested_version,",
+	   "passthrough=$passthrough,",
+	   "genprefix=\"$genprefix\",",
+	   "longprefix=\"$longprefix\".",
+	   "\n");
+    }
+
+    # Check for ref HASH as first argument.
+    # First argument may be an object. It's OK to use this as long
+    # as it is really a hash underneath.
+    $userlinkage = undef;
+    if ( @optionlist && ref($optionlist[0]) and
+	 UNIVERSAL::isa($optionlist[0],'HASH') ) {
+	$userlinkage = shift (@optionlist);
+	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
+    }
+
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    # Be careful not to interpret '<>' as option starters.
+    if ( @optionlist && $optionlist[0] =~ /^\W+$/
+	 && !($optionlist[0] eq '<>'
+	      && @optionlist > 0
+	      && ref($optionlist[1])) ) {
+	$prefix = shift (@optionlist);
+	# Turn into regexp. Needs to be parenthesized!
+	$prefix =~ s/(\W)/\\$1/g;
+	$prefix = "([" . $prefix . "])";
+	print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
+    }
+
+    # Verify correctness of optionlist.
+    %opctl = ();
+    while ( @optionlist ) {
+	my $opt = shift (@optionlist);
+
+	unless ( defined($opt) ) {
+	    $error .= "Undefined argument in option spec\n";
+	    next;
+	}
+
+	# Strip leading prefix so people can specify "--foo=i" if they like.
+	$opt = $+ if $opt =~ /^$prefix+(.*)$/s;
+
+	if ( $opt eq '<>' ) {
+	    if ( (defined $userlinkage)
+		&& !(@optionlist > 0 && ref($optionlist[0]))
+		&& (exists $userlinkage->{$opt})
+		&& ref($userlinkage->{$opt}) ) {
+		unshift (@optionlist, $userlinkage->{$opt});
+	    }
+	    unless ( @optionlist > 0
+		    && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
+		$error .= "Option spec <> requires a reference to a subroutine\n";
+		# Kill the linkage (to avoid another error).
+		shift (@optionlist)
+		  if @optionlist && ref($optionlist[0]);
+		next;
+	    }
+	    $linkage{'<>'} = shift (@optionlist);
+	    next;
+	}
+
+	# Parse option spec.
+	my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
+	unless ( defined $name ) {
+	    # Failed. $orig contains the error message. Sorry for the abuse.
+	    $error .= $orig;
+	    # Kill the linkage (to avoid another error).
+	    shift (@optionlist)
+	      if @optionlist && ref($optionlist[0]);
+	    next;
+	}
+
+	# If no linkage is supplied in the @optionlist, copy it from
+	# the userlinkage if available.
+	if ( defined $userlinkage ) {
+	    unless ( @optionlist > 0 && ref($optionlist[0]) ) {
+		if ( exists $userlinkage->{$orig} &&
+		     ref($userlinkage->{$orig}) ) {
+		    print STDERR ("=> found userlinkage for \"$orig\": ",
+				  "$userlinkage->{$orig}\n")
+			if $debug;
+		    unshift (@optionlist, $userlinkage->{$orig});
+		}
+		else {
+		    # Do nothing. Being undefined will be handled later.
+		    next;
+		}
+	    }
+	}
+
+	# Copy the linkage. If omitted, link to global variable.
+	if ( @optionlist > 0 && ref($optionlist[0]) ) {
+	    print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
+		if $debug;
+	    my $rl = ref($linkage{$orig} = shift (@optionlist));
+
+	    if ( $rl eq "ARRAY" ) {
+		$opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
+	    }
+	    elsif ( $rl eq "HASH" ) {
+		$opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
+	    }
+	    elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
+#		if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
+#		    my $t = $linkage{$orig};
+#		    $$t = $linkage{$orig} = [];
+#		}
+#		elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
+#		}
+#		else {
+		    # Ok.
+#		}
+	    }
+	    elsif ( $rl eq "CODE" ) {
+		# Ok.
+	    }
+	    else {
+		$error .= "Invalid option linkage for \"$opt\"\n";
+	    }
+	}
+	else {
+	    # Link to global $opt_XXX variable.
+	    # Make sure a valid perl identifier results.
+	    my $ov = $orig;
+	    $ov =~ s/\W/_/g;
+	    if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
+		print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
+	    }
+	    elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
+		print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
+	    }
+	    else {
+		print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
+	    }
+	}
+
+	if ( $opctl{$name}[CTL_TYPE] eq 'I'
+	     && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
+		  || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
+	   ) {
+	    $error .= "Invalid option linkage for \"$opt\"\n";
+	}
+
+    }
+
+    # Bail out if errors found.
+    die ($error) if $error;
+    $error = 0;
+
+    # Supply --version and --help support, if needed and allowed.
+    if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
+	if ( !defined($opctl{version}) ) {
+	    $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
+	    $linkage{version} = \&VersionMessage;
+	}
+	$auto_version = 1;
+    }
+    if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
+	if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
+	    $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
+	    $linkage{help} = \&HelpMessage;
+	}
+	$auto_help = 1;
+    }
+
+    # Show the options tables if debugging.
+    if ( $debug ) {
+	my ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
+	    $arrow = "   ";
+	}
+    }
+
+    # Process argument list
+    my $goon = 1;
+    while ( $goon && @$argv > 0 ) {
+
+	# Get next argument.
+	$opt = shift (@$argv);
+	print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
+
+	# Double dash is option list terminator.
+	if ( $opt eq $argend ) {
+	  push (@ret, $argend) if $passthrough;
+	  last;
+	}
+
+	# Look it up.
+	my $tryopt = $opt;
+	my $found;		# success status
+	my $key;		# key (if hash type)
+	my $arg;		# option argument
+	my $ctl;		# the opctl entry
+
+	($found, $opt, $ctl, $arg, $key) =
+	  FindOption ($argv, $prefix, $argend, $opt, \%opctl);
+
+	if ( $found ) {
+
+	    # FindOption undefines $opt in case of errors.
+	    next unless defined $opt;
+
+	    my $argcnt = 0;
+	    while ( defined $arg ) {
+
+		# Get the canonical name.
+		print STDERR ("=> cname for \"$opt\" is ") if $debug;
+		$opt = $ctl->[CTL_CNAME];
+		print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
+
+		if ( defined $linkage{$opt} ) {
+		    print STDERR ("=> ref(\$L{$opt}) -> ",
+				  ref($linkage{$opt}), "\n") if $debug;
+
+		    if ( ref($linkage{$opt}) eq 'SCALAR'
+			 || ref($linkage{$opt}) eq 'REF' ) {
+			if ( $ctl->[CTL_TYPE] eq '+' ) {
+			    print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
+			      if $debug;
+			    if ( defined ${$linkage{$opt}} ) {
+			        ${$linkage{$opt}} += $arg;
+			    }
+		            else {
+			        ${$linkage{$opt}} = $arg;
+			    }
+			}
+			elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
+			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+					  " to ARRAY\n")
+			      if $debug;
+			    my $t = $linkage{$opt};
+			    $$t = $linkage{$opt} = [];
+			    print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
+			      if $debug;
+			    push (@{$linkage{$opt}}, $arg);
+			}
+			elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+			    print STDERR ("=> ref(\$L{$opt}) auto-vivified",
+					  " to HASH\n")
+			      if $debug;
+			    my $t = $linkage{$opt};
+			    $$t = $linkage{$opt} = {};
+			    print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+			      if $debug;
+			    $linkage{$opt}->{$key} = $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")
+			    if $debug;
+			push (@{$linkage{$opt}}, $arg);
+		    }
+		    elsif ( ref($linkage{$opt}) eq 'HASH' ) {
+			print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$linkage{$opt}->{$key} = $arg;
+		    }
+		    elsif ( ref($linkage{$opt}) eq 'CODE' ) {
+			print STDERR ("=> &L{$opt}(\"$opt\"",
+				      $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
+				      ", \"$arg\")\n")
+			    if $debug;
+			my $eval_error = do {
+			    local $@;
+			    local $SIG{__DIE__}  = 'DEFAULT';
+			    eval {
+				&{$linkage{$opt}}
+				  (Getopt::Long::CallBack->new
+				   (name    => $opt,
+				    ctl     => $ctl,
+				    opctl   => \%opctl,
+				    linkage => \%linkage,
+				    prefix  => $prefix,
+				   ),
+				   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
+				   $arg);
+			    };
+			    $@;
+			};
+			print STDERR ("=> die($eval_error)\n")
+			  if $debug && $eval_error ne '';
+			if ( $eval_error =~ /^!/ ) {
+			    if ( $eval_error =~ /^!FINISH\b/ ) {
+				$goon = 0;
+			    }
+			}
+			elsif ( $eval_error ne '' ) {
+			    warn ($eval_error);
+			    $error++;
+			}
+		    }
+		    else {
+			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
+				      "\" in linkage\n");
+			die("Getopt::Long -- internal error!\n");
+		    }
+		}
+		# No entry in linkage means entry in userlinkage.
+		elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
+		    if ( defined $userlinkage->{$opt} ) {
+			print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
+			    if $debug;
+			push (@{$userlinkage->{$opt}}, $arg);
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
+			    if $debug;
+			$userlinkage->{$opt} = [$arg];
+		    }
+		}
+		elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+		    if ( defined $userlinkage->{$opt} ) {
+			print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
+			    if $debug;
+			$userlinkage->{$opt}->{$key} = $arg;
+		    }
+		    else {
+			print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
+			    if $debug;
+			$userlinkage->{$opt} = {$key => $arg};
+		    }
+		}
+		else {
+		    if ( $ctl->[CTL_TYPE] eq '+' ) {
+			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;
+		    }
+		}
+
+		$argcnt++;
+		last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
+		undef($arg);
+
+		# Need more args?
+		if ( $argcnt < $ctl->[CTL_AMIN] ) {
+		    if ( @$argv ) {
+			if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
+			    $arg = shift(@$argv);
+			    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
+			    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+			      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+			    next;
+			}
+			warn("Value \"$$argv[0]\" invalid for option $opt\n");
+			$error++;
+		    }
+		    else {
+			warn("Insufficient arguments for option $opt\n");
+			$error++;
+		    }
+		}
+
+		# Any more args?
+		if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
+		    $arg = shift(@$argv);
+		    $arg =~ tr/_//d if $ctl->[CTL_TYPE] =~ /^[iIo]$/;
+		    ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
+		      if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+		    next;
+		}
+	    }
+	}
+
+	# Not an option. Save it if we $PERMUTE and don't have a <>.
+	elsif ( $order == $PERMUTE ) {
+	    # Try non-options call-back.
+	    my $cb;
+	    if ( (defined ($cb = $linkage{'<>'})) ) {
+		print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
+		  if $debug;
+		my $eval_error = do {
+		    local $@;
+		    local $SIG{__DIE__}  = 'DEFAULT';
+		    eval {
+			&$cb
+			  (Getopt::Long::CallBack->new
+			   (name    => $tryopt,
+			    ctl     => $ctl,
+			    opctl   => \%opctl,
+			    linkage => \%linkage,
+			    prefix  => $prefix,
+			   ));
+		    };
+		    $@;
+		};
+		print STDERR ("=> die($eval_error)\n")
+		  if $debug && $eval_error ne '';
+		if ( $eval_error =~ /^!/ ) {
+		    if ( $eval_error =~ /^!FINISH\b/ ) {
+			$goon = 0;
+		    }
+		}
+		elsif ( $eval_error ne '' ) {
+		    warn ($eval_error);
+		    $error++;
+		}
+	    }
+	    else {
+		print STDERR ("=> saving \"$tryopt\" ",
+			      "(not an option, may permute)\n") if $debug;
+		push (@ret, $tryopt);
+	    }
+	    next;
+	}
+
+	# ...otherwise, terminate.
+	else {
+	    # Push this one back and exit.
+	    unshift (@$argv, $tryopt);
+	    return ($error == 0);
+	}
+
+    }
+
+    # Finish.
+    if ( @ret && $order == $PERMUTE ) {
+	#  Push back accumulated arguments
+	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
+	    if $debug;
+	unshift (@$argv, @ret);
+    }
+
+    return ($error == 0);
+}
+
+# A readable representation of what's in an optbl.
+sub OptCtl ($) {
+    my ($v) = @_;
+    my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
+    "[".
+      join(",",
+	   "\"$v[CTL_TYPE]\"",
+	   "\"$v[CTL_CNAME]\"",
+	   "\"$v[CTL_DEFAULT]\"",
+	   ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
+	   $v[CTL_AMIN] || '',
+	   $v[CTL_AMAX] || '',
+#	   $v[CTL_RANGE] || '',
+#	   $v[CTL_REPEAT] || '',
+	  ). "]";
+}
+
+# Parse an option specification and fill the tables.
+sub ParseOptionSpec ($$) {
+    my ($opt, $opctl) = @_;
+
+    # Match option spec.
+    if ( $opt !~ m;^
+		   (
+		     # Option name
+		     (?: \w+[-\w]* )
+		     # Alias names, or "?"
+		     (?: \| (?: \? | \w[-\w]* ) )*
+		   )?
+		   (
+		     # Either modifiers ...
+		     [!+]
+		     |
+		     # ... or a value/dest/repeat specification
+		     [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
+		     |
+		     # ... or an optional-with-default spec
+		     : (?: -?\d+ | \+ ) [@%]?
+		   )?
+		   $;x ) {
+	return (undef, "Error in option spec: \"$opt\"\n");
+    }
+
+    my ($names, $spec) = ($1, $2);
+    $spec = '' unless defined $spec;
+
+    # $orig keeps track of the primary name the user specified.
+    # This name will be used for the internal or external linkage.
+    # In other words, if the user specifies "FoO|BaR", it will
+    # match any case combinations of 'foo' and 'bar', but if a global
+    # variable needs to be set, it will be $opt_FoO in the exact case
+    # as specified.
+    my $orig;
+
+    my @names;
+    if ( defined $names ) {
+	@names =  split (/\|/, $names);
+	$orig = $names[0];
+    }
+    else {
+	@names = ('');
+	$orig = '';
+    }
+
+    # Construct the opctl entries.
+    my $entry;
+    if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
+	# Fields are hard-wired here.
+	$entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
+    }
+    elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
+	my $def = $1;
+	my $dest = $2;
+	my $type = $def eq '+' ? 'I' : 'i';
+	$dest ||= '$';
+	$dest = $dest eq '@' ? CTL_DEST_ARRAY
+	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+	# Fields are hard-wired here.
+	$entry = [$type,$orig,$def eq '+' ? undef : $def,
+		  $dest,0,1];
+    }
+    else {
+	my ($mand, $type, $dest) =
+	  $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
+	return (undef, "Cannot repeat while bundling: \"$opt\"\n")
+	  if $bundling && defined($4);
+	my ($mi, $cm, $ma) = ($5, $6, $7);
+	return (undef, "{0} is useless in option spec: \"$opt\"\n")
+	  if defined($mi) && !$mi && !defined($ma) && !defined($cm);
+
+	$type = 'i' if $type eq 'n';
+	$dest ||= '$';
+	$dest = $dest eq '@' ? CTL_DEST_ARRAY
+	  : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
+	# Default minargs to 1/0 depending on mand status.
+	$mi = $mand eq '=' ? 1 : 0 unless defined $mi;
+	# Adjust mand status according to minargs.
+	$mand = $mi ? '=' : ':';
+	# Adjust maxargs.
+	$ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
+	return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
+	  if defined($ma) && !$ma;
+	return (undef, "Max less than min in option spec: \"$opt\"\n")
+	  if defined($ma) && $ma < $mi;
+
+	# Fields are hard-wired here.
+	$entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
+    }
+
+    # Process all names. First is canonical, the rest are aliases.
+    my $dups = '';
+    foreach ( @names ) {
+
+	$_ = lc ($_)
+	  if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
+
+	if ( exists $opctl->{$_} ) {
+	    $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
+	}
+
+	if ( $spec eq '!' ) {
+	    $opctl->{"no$_"} = $entry;
+	    $opctl->{"no-$_"} = $entry;
+	    $opctl->{$_} = [@$entry];
+	    $opctl->{$_}->[CTL_TYPE] = '';
+	}
+	else {
+	    $opctl->{$_} = $entry;
+	}
+    }
+
+    if ( $dups && $^W ) {
+	foreach ( split(/\n+/, $dups) ) {
+	    warn($_."\n");
+	}
+    }
+    ($names[0], $orig);
+}
+
+# Option lookup.
+sub FindOption ($$$$$) {
+
+    # returns (1, $opt, $ctl, $arg, $key) if okay,
+    # returns (1, undef) if option in error,
+    # returns (0) otherwise.
+
+    my ($argv, $prefix, $argend, $opt, $opctl) = @_;
+
+    print STDERR ("=> find \"$opt\"\n") if $debug;
+
+    return (0) unless $opt =~ /^$prefix(.*)$/s;
+    return (0) if $opt eq "-" && !defined $opctl->{''};
+
+    $opt = $+;
+    my $starter = $1;
+
+    print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
+
+    my $optarg;			# value supplied with --opt=value
+    my $rest;			# remainder from unbundling
+
+    # If it is a long option, it may include the value.
+    # With getopt_compat, only if not bundling.
+    if ( ($starter=~/^$longprefix$/
+          || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
+	  && $opt =~ /^([^=]+)=(.*)$/s ) {
+	$opt = $1;
+	$optarg = $2;
+	print STDERR ("=> option \"", $opt,
+		      "\", optarg = \"$optarg\"\n") if $debug;
+    }
+
+    #### Look it up ###
+
+    my $tryopt = $opt;		# option to try
+
+    if ( $bundling && $starter eq '-' ) {
+
+	# To try overrides, obey case ignore.
+	$tryopt = $ignorecase ? lc($opt) : $opt;
+
+	# If bundling == 2, long options can override bundles.
+	if ( $bundling == 2 && length($tryopt) > 1
+	     && defined ($opctl->{$tryopt}) ) {
+	    print STDERR ("=> $starter$tryopt overrides unbundling\n")
+	      if $debug;
+	}
+	else {
+	    $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;
+	    $rest = undef unless $rest ne '';
+	}
+    }
+
+    # Try auto-abbreviation.
+    elsif ( $autoabbrev && $opt ne "" ) {
+	# Sort the possible long option names.
+	my @names = sort(keys (%$opctl));
+	# Downcase if allowed.
+	$opt = lc ($opt) if $ignorecase;
+	$tryopt = $opt;
+	# Turn option name into pattern.
+	my $pat = quotemeta ($opt);
+	# Look up in option names.
+	my @hits = grep (/^$pat/, @names);
+	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
+		      "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 ) {
+		my $hit = $_;
+		$hit = $opctl->{$hit}->[CTL_CNAME]
+		  if defined $opctl->{$hit}->[CTL_CNAME];
+		$hit{$hit} = 1;
+	    }
+	    # Remove auto-supplied options (version, help).
+	    if ( keys(%hit) == 2 ) {
+		if ( $auto_version && exists($hit{version}) ) {
+		    delete $hit{version};
+		}
+		elsif ( $auto_help && exists($hit{help}) ) {
+		    delete $hit{help};
+		}
+	    }
+	    # Now see if it really is ambiguous.
+	    unless ( keys(%hit) == 1 ) {
+		return (0) if $passthrough;
+		warn ("Option ", $opt, " is ambiguous (",
+		      join(", ", @hits), ")\n");
+		$error++;
+		return (1, undef);
+	    }
+	    @hits = keys(%hit);
+	}
+
+	# Complete the option name, if appropriate.
+	if ( @hits == 1 && $hits[0] ne $opt ) {
+	    $tryopt = $hits[0];
+	    $tryopt = lc ($tryopt) if $ignorecase;
+	    print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
+		if $debug;
+	}
+    }
+
+    # Map to all lowercase if ignoring case.
+    elsif ( $ignorecase ) {
+	$tryopt = lc ($opt);
+    }
+
+    # Check validity by fetching the info.
+    my $ctl = $opctl->{$tryopt};
+    unless  ( defined $ctl ) {
+	return (0) if $passthrough;
+	# Pretend one char when bundling.
+	if ( $bundling == 1 && length($starter) == 1 ) {
+	    $opt = substr($opt,0,1);
+            unshift (@$argv, $starter.$rest) if defined $rest;
+	}
+	if ( $opt eq "" ) {
+	    warn ("Missing option after ", $starter, "\n");
+	}
+	else {
+	    warn ("Unknown option: ", $opt, "\n");
+	}
+	$error++;
+	return (1, undef);
+    }
+    # Apparently valid.
+    $opt = $tryopt;
+    print STDERR ("=> found ", OptCtl($ctl),
+		  " for \"", $opt, "\"\n") if $debug;
+
+    #### Determine argument status ####
+
+    # If it is an option w/o argument, we're almost finished with it.
+    my $type = $ctl->[CTL_TYPE];
+    my $arg;
+
+    if ( $type eq '' || $type eq '!' || $type eq '+' ) {
+	if ( defined $optarg ) {
+	    return (0) if $passthrough;
+	    warn ("Option ", $opt, " does not take an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	elsif ( $type eq '' || $type eq '+' ) {
+	    # Supply explicit value.
+	    $arg = 1;
+	}
+	else {
+	    $opt =~ s/^no-?//i;	# strip NO prefix
+	    $arg = 0;		# supply explicit value
+	}
+	unshift (@$argv, $starter.$rest) if defined $rest;
+	return (1, $opt, $ctl, $arg);
+    }
+
+    # Get mandatory status and type info.
+    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';
+    }
+
+    # 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 && !($type eq 's' ? defined($optarg) : 0) ) {
+	if ( $mand ) {
+	    return (0) if $passthrough;
+	    warn ("Option ", $opt, " requires an argument\n");
+	    $error++;
+	    return (1, undef);
+	}
+	if ( $type eq 'I' ) {
+	    # Fake incremental type.
+	    my @c = @$ctl;
+	    $c[CTL_TYPE] = '+';
+	    return (1, $opt, \@c, 1);
+	}
+	return (1, $opt, $ctl,
+		defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
+		$type eq 's' ? '' : 0);
+    }
+
+    # Get (possibly optional) argument.
+    $arg = (defined $rest ? $rest
+	    : (defined $optarg ? $optarg : shift (@$argv)));
+
+    # Get key if this is a "name=value" pair for a hash option.
+    my $key;
+    if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
+	($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
+	  : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
+	     ($mand ? undef : ($type eq 's' ? "" : 1)));
+	if (! defined $arg) {
+	    warn ("Option $opt, key \"$key\", requires a value\n");
+	    $error++;
+	    # Push back.
+	    unshift (@$argv, $starter.$rest) if defined $rest;
+	    return (1, undef);
+	}
+    }
+
+    #### Check if the argument is valid for this option ####
+
+    my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
+
+    if ( $type eq 's' ) {	# string
+	# A mandatory string takes anything.
+	return (1, $opt, $ctl, $arg, $key) if $mand;
+
+	# Same for optional string as a hash value
+	return (1, $opt, $ctl, $arg, $key)
+	  if $ctl->[CTL_DEST] == CTL_DEST_HASH;
+
+	# An optional string takes almost anything.
+	return (1, $opt, $ctl, $arg, $key)
+	  if defined $optarg || defined $rest;
+	return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
+
+	# Check for option or option list terminator.
+	if ($arg eq $argend ||
+	    $arg =~ /^$prefix.+/) {
+	    # Push back.
+	    unshift (@$argv, $arg);
+	    # Supply empty value.
+	    $arg = '';
+	}
+    }
+
+    elsif ( $type eq 'i'	# numeric/integer
+            || $type eq 'I'	# numeric/integer w/ incr default
+	    || $type eq 'o' ) { # dec/oct/hex/bin value
+
+	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
+
+	if ( $bundling && defined $rest
+	     && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
+	    ($key, $arg, $rest) = ($1, $2, $+);
+	    chop($key) if $key;
+	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
+	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg =~ /^$o_valid$/si ) {
+	    $arg =~ tr/_//d;
+	    $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
+	}
+	else {
+	    if ( defined $optarg || $mand ) {
+		if ( $passthrough ) {
+		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
+		      unless defined $optarg;
+		    return (0);
+		}
+		warn ("Value \"", $arg, "\" invalid for option ",
+		      $opt, " (",
+		      $type eq 'o' ? "extended " : '',
+		      "number expected)\n");
+		$error++;
+		# Push back.
+		unshift (@$argv, $starter.$rest) if defined $rest;
+		return (1, undef);
+	    }
+	    else {
+		# Push back.
+		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
+		if ( $type eq 'I' ) {
+		    # Fake incremental type.
+		    my @c = @$ctl;
+		    $c[CTL_TYPE] = '+';
+		    return (1, $opt, \@c, 1);
+		}
+		# Supply default value.
+		$arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
+	    }
+	}
+    }
+
+    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;
+	if ( $bundling && defined $rest &&
+	     $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
+	    $arg =~ tr/_//d;
+	    ($key, $arg, $rest) = ($1, $2, $+);
+	    chop($key) if $key;
+	    unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg =~ /^$o_valid$/ ) {
+	    $arg =~ tr/_//d;
+	}
+	else {
+	    if ( defined $optarg || $mand ) {
+		if ( $passthrough ) {
+		    unshift (@$argv, defined $rest ? $starter.$rest : $arg)
+		      unless defined $optarg;
+		    return (0);
+		}
+		warn ("Value \"", $arg, "\" invalid for option ",
+		      $opt, " (real number expected)\n");
+		$error++;
+		# Push back.
+		unshift (@$argv, $starter.$rest) if defined $rest;
+		return (1, undef);
+	    }
+	    else {
+		# Push back.
+		unshift (@$argv, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0.0;
+	    }
+	}
+    }
+    else {
+	die("Getopt::Long internal error (Can't happen)\n");
+    }
+    return (1, $opt, $ctl, $arg, $key);
+}
+
+sub ValidValue ($$$$$) {
+    my ($ctl, $arg, $mand, $argend, $prefix) = @_;
+
+    if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
+	return 0 unless $arg =~ /[^=]+=(.*)/;
+	$arg = $1;
+    }
+
+    my $type = $ctl->[CTL_TYPE];
+
+    if ( $type eq 's' ) {	# string
+	# A mandatory string takes anything.
+	return (1) if $mand;
+
+	return (1) if $arg eq "-";
+
+	# Check for option or option list terminator.
+	return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
+	return 1;
+    }
+
+    elsif ( $type eq 'i'	# numeric/integer
+            || $type eq 'I'	# numeric/integer w/ incr default
+	    || $type eq 'o' ) { # dec/oct/hex/bin value
+
+	my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
+	return $arg =~ /^$o_valid$/si;
+    }
+
+    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$/;
+    }
+    die("ValidValue: Cannot happen\n");
+}
+
+# Getopt::Long Configuration.
+sub Configure (@) {
+    my (@options) = @_;
+
+    my $prevconfig =
+      [ $error, $debug, $major_version, $minor_version,
+	$autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
+	$gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
+	$longprefix ];
+
+    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)};
+    }
+
+    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') && $action ) {
+	    ConfigDefaults ();
+	}
+	elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
+	    local $ENV{POSIXLY_CORRECT};
+	    $ENV{POSIXLY_CORRECT} = 1 if $action;
+	    ConfigDefaults ();
+	}
+	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+	    $autoabbrev = $action;
+	}
+	elsif ( $try eq 'getopt_compat' ) {
+	    $getopt_compat = $action;
+            $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
+	}
+	elsif ( $try eq 'gnu_getopt' ) {
+	    if ( $action ) {
+		$gnu_compat = 1;
+		$bundling = 1;
+		$getopt_compat = 0;
+                $genprefix = "(--|-)";
+		$order = $PERMUTE;
+	    }
+	}
+	elsif ( $try eq 'gnu_compat' ) {
+	    $gnu_compat = $action;
+	}
+	elsif ( $try =~ /^(auto_?)?version$/ ) {
+	    $auto_version = $action;
+	}
+	elsif ( $try =~ /^(auto_?)?help$/ ) {
+	    $auto_help = $action;
+	}
+	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+	    $ignorecase = $action;
+	}
+	elsif ( $try eq 'ignorecase_always' or $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=(.+)$/ && $action ) {
+	    $genprefix = $1;
+	    # Turn into regexp. Needs to be parenthesized!
+	    $genprefix = "(" . quotemeta($genprefix) . ")";
+	    eval { '' =~ /$genprefix/; };
+	    die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+	}
+	elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
+	    $genprefix = $1;
+	    # Parenthesize if needed.
+	    $genprefix = "(" . $genprefix . ")"
+	      unless $genprefix =~ /^\(.*\)$/;
+	    eval { '' =~ m"$genprefix"; };
+	    die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
+	}
+	elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
+	    $longprefix = $1;
+	    # Parenthesize if needed.
+	    $longprefix = "(" . $longprefix . ")"
+	      unless $longprefix =~ /^\(.*\)$/;
+	    eval { '' =~ m"$longprefix"; };
+	    die("Getopt::Long: invalid long prefix pattern \"$longprefix\"") if $@;
+	}
+	elsif ( $try eq 'debug' ) {
+	    $debug = $action;
+	}
+	else {
+	    die("Getopt::Long: unknown config parameter \"$opt\"")
+	}
+    }
+    $prevconfig;
+}
+
+# Deprecated name.
+sub config (@) {
+    Configure (@_);
+}
+
+# Issue a standard message for --version.
+#
+# The arguments are mostly the same as for Pod::Usage::pod2usage:
+#
+#  - a number (exit value)
+#  - a string (lead in message)
+#  - a hash with options. See Pod::Usage for details.
+#
+sub VersionMessage(@) {
+    # Massage args.
+    my $pa = setup_pa_args("version", @_);
+
+    my $v = $main::VERSION;
+    my $fh = $pa->{-output} ||
+      ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
+
+    print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
+	       $0, defined $v ? " version $v" : (),
+	       "\n",
+	       "(", __PACKAGE__, "::", "GetOptions",
+	       " version ",
+	       defined($Getopt::Long::VERSION_STRING)
+	         ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
+	       " Perl version ",
+	       $] >= 5.006 ? sprintf("%vd", $^V) : $],
+	       ")\n");
+    exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
+}
+
+# Issue a standard message for --help.
+#
+# The arguments are the same as for Pod::Usage::pod2usage:
+#
+#  - a number (exit value)
+#  - a string (lead in message)
+#  - a hash with options. See Pod::Usage for details.
+#
+sub HelpMessage(@) {
+    eval {
+	require Pod::Usage;
+	import Pod::Usage;
+	1;
+    } || die("Cannot provide help: cannot load Pod::Usage\n");
+
+    # Note that pod2usage will issue a warning if -exitval => NOEXIT.
+    pod2usage(setup_pa_args("help", @_));
+
+}
+
+# Helper routine to set up a normalized hash ref to be used as
+# argument to pod2usage.
+sub setup_pa_args($@) {
+    my $tag = shift;		# who's calling
+
+    # If called by direct binding to an option, it will get the option
+    # name and value as arguments. Remove these, if so.
+    @_ = () if @_ == 2 && $_[0] eq $tag;
+
+    my $pa;
+    if ( @_ > 1 ) {
+	$pa = { @_ };
+    }
+    else {
+	$pa = shift || {};
+    }
+
+    # At this point, $pa can be a number (exit value), string
+    # (message) or hash with options.
+
+    if ( UNIVERSAL::isa($pa, 'HASH') ) {
+	# Get rid of -msg vs. -message ambiguity.
+	$pa->{-message} = $pa->{-msg};
+	delete($pa->{-msg});
+    }
+    elsif ( $pa =~ /^-?\d+$/ ) {
+	$pa = { -exitval => $pa };
+    }
+    else {
+	$pa = { -message => $pa };
+    }
+
+    # These are _our_ defaults.
+    $pa->{-verbose} = 0 unless exists($pa->{-verbose});
+    $pa->{-exitval} = 0 unless exists($pa->{-exitval});
+    $pa;
+}
+
+# Sneak way to know what version the user requested.
+sub VERSION {
+    $requested_version = $_[1];
+    shift->SUPER::VERSION(@_);
+}
+
+package Getopt::Long::CallBack;
+
+sub new {
+    my ($pkg, %atts) = @_;
+    bless { %atts }, $pkg;
+}
+
+sub name {
+    my $self = shift;
+    ''.$self->{name};
+}
+
+use overload
+  # Treat this object as an ordinary string for legacy API.
+  '""'	   => \&name,
+  fallback => 1;
+
+1;
+
+################ Documentation ################
+
+=head1 NAME
+
+Getopt::Long - Extended processing of command line options
+
+=head1 SYNOPSIS
+
+  use Getopt::Long;
+  my $data   = "file.dat";
+  my $length = 24;
+  my $verbose;
+  $result = GetOptions ("length=i" => \$length,    # numeric
+                        "file=s"   => \$data,      # string
+			"verbose"  => \$verbose);  # flag
+
+=head1 DESCRIPTION
+
+The Getopt::Long module implements an extended getopt function called
+GetOptions(). This function adheres to the POSIX syntax for command
+line options, with GNU extensions. In general, this means that options
+have long names instead of single letters, and are introduced with a
+double dash "--". Support for bundling of command line options, as was
+the case with the more traditional single-letter approach, is provided
+but not enabled by default.
+
+=head1 Command Line Options, an Introduction
+
+Command line operated programs traditionally take their arguments from
+the command line, for example filenames or other information that the
+program needs to know. Besides arguments, these programs often take
+command line I<options> as well. Options are not necessary for the
+program to work, hence the name 'option', but are used to modify its
+default behaviour. For example, a program could do its job quietly,
+but with a suitable option it could provide verbose information about
+what it did.
+
+Command line options come in several flavours. Historically, they are
+preceded by a single dash C<->, and consist of a single letter.
+
+    -l -a -c
+
+Usually, these single-character options can be bundled:
+
+    -lac
+
+Options can have values, the value is placed after the option
+character. Sometimes with whitespace in between, sometimes not:
+
+    -s 24 -s24
+
+Due to the very cryptic nature of these options, another style was
+developed that used long names. So instead of a cryptic C<-l> one
+could use the more descriptive C<--long>. To distinguish between a
+bundle of single-character options and a long one, two dashes are used
+to precede the option name. Early implementations of long options used
+a plus C<+> instead. Also, option values could be specified either
+like
+
+    --size=24
+
+or
+
+    --size 24
+
+The C<+> form is now obsolete and strongly deprecated.
+
+=head1 Getting Started with Getopt::Long
+
+Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
+first Perl module that provided support for handling the new style of
+command line options, hence the name Getopt::Long. This module also
+supports single-character options and bundling. Single character
+options may be any alphabetic character, a question mark, and a dash.
+Long options may consist of a series of letters, digits, and dashes.
+Although this is currently not enforced by Getopt::Long, multiple
+consecutive dashes are not allowed, and the option name must not end
+with a dash.
+
+To use Getopt::Long from a Perl program, you must include the
+following line in your Perl program:
+
+    use Getopt::Long;
+
+This will load the core of the Getopt::Long module and prepare your
+program for using it. Most of the actual Getopt::Long code is not
+loaded until you really call one of its functions.
+
+In the default configuration, options names may be abbreviated to
+uniqueness, case does not matter, and a single dash is sufficient,
+even for long option names. Also, options may be placed between
+non-option arguments. See L<Configuring Getopt::Long> for more
+details on how to configure Getopt::Long.
+
+=head2 Simple options
+
+The most simple options are the ones that take no values. Their mere
+presence on the command line enables the option. Popular examples are:
+
+    --all --verbose --quiet --debug
+
+Handling simple options is straightforward:
+
+    my $verbose = '';	# option variable with default value (false)
+    my $all = '';	# option variable with default value (false)
+    GetOptions ('verbose' => \$verbose, 'all' => \$all);
+
+The call to GetOptions() parses the command line arguments that are
+present in C<@ARGV> and sets the option variable to the value C<1> if
+the option did occur on the command line. Otherwise, the option
+variable is not touched. Setting the option value to true is often
+called I<enabling> the option.
+
+The option name as specified to the GetOptions() function is called
+the option I<specification>. Later we'll see that this specification
+can contain more than just the option name. The reference to the
+variable is called the option I<destination>.
+
+GetOptions() will return a true value if the command line could be
+processed successfully. Otherwise, it will write error messages to
+STDERR, and return a false result.
+
+=head2 A little bit less simple options
+
+Getopt::Long supports two useful variants of simple options:
+I<negatable> options and I<incremental> options.
+
+A negatable option is specified with an exclamation mark C<!> after the
+option name:
+
+    my $verbose = '';	# option variable with default value (false)
+    GetOptions ('verbose!' => \$verbose);
+
+Now, using C<--verbose> on the command line will enable C<$verbose>,
+as expected. But it is also allowed to use C<--noverbose>, which will
+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>.
+
+An incremental option is specified with a plus C<+> after the
+option name:
+
+    my $verbose = '';	# option variable with default value (false)
+    GetOptions ('verbose+' => \$verbose);
+
+Using C<--verbose> on the command line will increment the value of
+C<$verbose>. This way the program can keep track of how many times the
+option occurred on the command line. For example, each occurrence of
+C<--verbose> could increase the verbosity level of the program.
+
+=head2 Mixing command line option with other arguments
+
+Usually programs take command line options as well as other arguments,
+for example, file names. It is good practice to always specify the
+options first, and the other arguments last. Getopt::Long will,
+however, allow the options and arguments to be mixed and 'filter out'
+all the options before passing the rest of the arguments to the
+program. To stop Getopt::Long from processing further arguments,
+insert a double dash C<--> on the command line:
+
+    --size 24 -- --all
+
+In this example, C<--all> will I<not> be treated as an option, but
+passed to the program unharmed, in C<@ARGV>.
+
+=head2 Options with values
+
+For options that take values it must be specified whether the option
+value is required or not, and what kind of value the option expects.
+
+Three kinds of values are supported: integer numbers, floating point
+numbers, and strings.
+
+If the option value is required, Getopt::Long will take the
+command line argument that follows the option and assign this to the
+option variable. If, however, the option value is specified as
+optional, this will only be done if that value does not look like a
+valid command line option itself.
+
+    my $tag = '';	# option variable with default value
+    GetOptions ('tag=s' => \$tag);
+
+In the option specification, the option name is followed by an equals
+sign C<=> and the letter C<s>. The equals sign indicates that this
+option requires a value. The letter C<s> indicates that this value is
+an arbitrary string. Other possible value types are C<i> for integer
+values, and C<f> for floating point values. Using a colon C<:> instead
+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>.
+
+=head2 Options with multiple values
+
+Options sometimes take several values. For example, a program could
+use multiple directories to search for library files:
+
+    --library lib/stdlib --library lib/extlib
+
+To accomplish this behaviour, simply specify an array reference as the
+destination for the option:
+
+    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
+destination:
+
+    GetOptions ("library=s@" => \$libfiles);
+
+Used with the example above, C<@libfiles> (or C<@$libfiles>) would
+contain two strings upon completion: C<"lib/srdlib"> and
+C<"lib/extlib">, in that order. It is also possible to specify that
+only integer or floating point numbers are acceptable values.
+
+Often it is useful to allow comma-separated lists of values as well as
+multiple occurrences of the options. This is easy using Perl's split()
+and join() operators:
+
+    GetOptions ("library=s" => \@libfiles);
+    @libfiles = split(/,/,join(',',@libfiles));
+
+Of course, it is important to choose the right separator string for
+each purpose.
+
+Warning: What follows is an experimental feature.
+
+Options can take multiple values at once, for example
+
+    --coordinates 52.2 16.4 --rgbcolor 255 255 149
+
+This can be accomplished by adding a repeat specifier to the option
+specification. Repeat specifiers are very similar to the C<{...}>
+repeat specifiers that can be used with regular expression patterns.
+For example, the above command line would be handled as follows:
+
+    GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
+
+The destination for the option must be an array or array reference.
+
+It is also possible to specify the minimal and maximal number of
+arguments an option takes. C<foo=s{2,4}> indicates an option that
+takes at least two and at most 4 arguments. C<foo=s{,}> indicates one
+or more values; C<foo:s{,}> indicates zero or more option values.
+
+=head2 Options with hash values
+
+If the option destination is a reference to a hash, the option will
+take, as value, strings of the form I<key>C<=>I<value>. The value will
+be stored with the specified key in the hash.
+
+    GetOptions ("define=s" => \%defines);
+
+Alternatively you can use:
+
+    GetOptions ("define=s%" => \$defines);
+
+When used with command line options:
+
+    --define os=linux --define vendor=redhat
+
+the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
+with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
+also possible to specify that only integer or floating point numbers
+are acceptable values. The keys are always taken to be strings.
+
+=head2 User-defined subroutines to handle options
+
+Ultimate control over what should be done when (actually: each time)
+an option is encountered on the command line can be achieved by
+designating a reference to a subroutine (or an anonymous subroutine)
+as the option destination. When GetOptions() encounters the option, it
+will call the subroutine with two or three arguments. The first
+argument is the name of the option. (Actually, it is an object that
+stringifies to the name of the option.) For a scalar or array destination,
+the second argument is the value to be stored. For a hash destination,
+the second arguments is the key to the hash, and the third argument
+the value to be stored. It is up to the subroutine to store the value,
+or do whatever it thinks is appropriate.
+
+A trivial application of this mechanism is to implement options that
+are related to each other. For example:
+
+    my $verbose = '';	# option variable with default value (false)
+    GetOptions ('verbose' => \$verbose,
+	        'quiet'   => sub { $verbose = 0 });
+
+Here C<--verbose> and C<--quiet> control the same variable
+C<$verbose>, but with opposite values.
+
+If the subroutine needs to signal an error, it should call die() with
+the desired error message as its argument. GetOptions() will catch the
+die(), issue the error message, and record that an error result must
+be returned upon completion.
+
+If the text of the error message starts with an exclamation mark C<!>
+it is interpreted specially by GetOptions(). There is currently one
+special command implemented: C<die("!FINISH")> will cause GetOptions()
+to stop processing options, as if it encountered a double dash C<-->.
+
+In version 2.37 the first argument to the callback function was
+changed from string to object. This was done to make room for
+extensions and more detailed control. The object stringifies to the
+option name so this change should not introduce compatibility
+problems.
+
+=head2 Options with multiple names
+
+Often it is user friendly to supply alternate mnemonic names for
+options. For example C<--height> could be an alternate name for
+C<--length>. Alternate names can be included in the option
+specification, separated by vertical bar C<|> characters. To implement
+the above example:
+
+    GetOptions ('length|height=f' => \$length);
+
+The first name is called the I<primary> name, the other names are
+called I<aliases>. When using a hash to store options, the key will
+always be the primary name.
+
+Multiple alternate names are possible.
+
+=head2 Case and abbreviations
+
+Without additional configuration, GetOptions() will ignore the case of
+option names, and allow the options to be abbreviated to uniqueness.
+
+    GetOptions ('length|height=f' => \$length, "head" => \$head);
+
+This call will allow C<--l> and C<--L> for the length option, but
+requires a least C<--hea> and C<--hei> for the head and height options.
+
+=head2 Summary of Option Specifications
+
+Each option specifier consists of two parts: the name specification
+and the argument specification.
+
+The name specification contains the name of the option, optionally
+followed by a list of alternative names separated by vertical bar
+characters.
+
+    length	      option name is "length"
+    length|size|l     name is "length", aliases are "size" and "l"
+
+The argument specification is optional. If omitted, the option is
+considered boolean, a value of 1 will be assigned when the option is
+used on the command line.
+
+The argument specification can be
+
+=over 4
+
+=item !
+
+The option does not take an argument and may be negated by prefixing
+it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
+1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
+0 will be assigned). If the option has aliases, this applies to the
+aliases as well.
+
+Using negation on a single letter option when bundling is in effect is
+pointless and will result in a warning.
+
+=item +
+
+The option does not take an argument and will be incremented by 1
+every time it appears on the command line. E.g. C<"more+">, when used
+with C<--more --more --more>, will increment the value three times,
+resulting in a value of 3 (provided it was 0 or undefined at first).
+
+The C<+> specifier is ignored if the option destination is not a scalar.
+
+=item = I<type> [ I<desttype> ] [ I<repeat> ]
+
+The option requires an argument of the given type. Supported types
+are:
+
+=over 4
+
+=item s
+
+String. An arbitrary sequence of characters. It is valid for the
+argument to start with C<-> or C<-->.
+
+=item i
+
+Integer. An optional leading plus or minus sign, followed by a
+sequence of digits.
+
+=item o
+
+Extended integer, Perl style. This can be either an optional leading
+plus or minus sign, followed by a sequence of digits, or an octal
+string (a zero, optionally followed by '0', '1', .. '7'), or a
+hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
+insensitive), or a binary string (C<0b> followed by a series of '0'
+and '1').
+
+=item f
+
+Real number. For example C<3.14>, C<-6.23E24> and so on.
+
+=back
+
+The I<desttype> can be C<@> or C<%> to specify that the option is
+list or a hash valued. This is only needed when the destination for
+the option value is not otherwise specified. It should be omitted when
+not needed.
+
+The I<repeat> specifies the number of values this option takes per
+occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
+
+I<min> denotes the minimal number of arguments. It defaults to 1 for
+options with C<=> and to 0 for options with C<:>, see below. Note that
+I<min> overrules the C<=> / C<:> semantics.
+
+I<max> denotes the maximum number of arguments. It must be at least
+I<min>. If I<max> is omitted, I<but the comma is not>, there is no
+upper bound to the number of argument values taken.
+
+=item : I<type> [ I<desttype> ]
+
+Like C<=>, but designates the argument as optional.
+If omitted, an empty string will be assigned to string values options,
+and the value zero to numeric options.
+
+Note that if a string argument starts with C<-> or C<-->, it will be
+considered an option on itself.
+
+=item : I<number> [ I<desttype> ]
+
+Like C<:i>, but if the value is omitted, the I<number> will be assigned.
+
+=item : + [ I<desttype> ]
+
+Like C<:i>, but if the value is omitted, the current value for the
+option will be incremented.
+
+=back
+
+=head1 Advanced Possibilities
+
+=head2 Object oriented interface
+
+Getopt::Long can be used in an object oriented way as well:
+
+    use Getopt::Long;
+    $p = new Getopt::Long::Parser;
+    $p->configure(...configuration options...);
+    if ($p->getoptions(...options descriptions...)) ...
+
+Configuration options can be passed to the constructor:
+
+    $p = new Getopt::Long::Parser
+             config => [...configuration options...];
+
+=head2 Thread Safety
+
+Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
+I<not> thread safe when using the older (experimental and now
+obsolete) threads implementation that was added to Perl 5.005.
+
+=head2 Documentation and help texts
+
+Getopt::Long encourages the use of Pod::Usage to produce help
+messages. For example:
+
+    use Getopt::Long;
+    use Pod::Usage;
+
+    my $man = 0;
+    my $help = 0;
+
+    GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
+    pod2usage(1) if $help;
+    pod2usage(-exitstatus => 0, -verbose => 2) if $man;
+
+    __END__
+
+    =head1 NAME
+
+    sample - Using Getopt::Long and Pod::Usage
+
+    =head1 SYNOPSIS
+
+    sample [options] [file ...]
+
+     Options:
+       -help            brief help message
+       -man             full documentation
+
+    =head1 OPTIONS
+
+    =over 8
+
+    =item B<-help>
+
+    Print a brief help message and exits.
+
+    =item B<-man>
+
+    Prints the manual page and exits.
+
+    =back
+
+    =head1 DESCRIPTION
+
+    B<This program> will read the given input file(s) and do something
+    useful with the contents thereof.
+
+    =cut
+
+See L<Pod::Usage> for details.
+
+=head2 Parsing options from an arbitrary array
+
+By default, GetOptions parses the options that are present in the
+global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
+used to parse options from an arbitrary array.
+
+    use Getopt::Long qw(GetOptionsFromArray);
+    $ret = GetOptionsFromArray(\@myopts, ...);
+
+When used like this, the global C<@ARGV> is not touched at all.
+
+The following two calls behave identically:
+
+    $ret = GetOptions( ... );
+    $ret = GetOptionsFromArray(\@ARGV, ... );
+
+=head2 Parsing options from an arbitrary string
+
+A special entry C<GetOptionsFromString> can be used to parse options
+from an arbitrary string.
+
+    use Getopt::Long qw(GetOptionsFromString);
+    $ret = GetOptionsFromString($string, ...);
+
+The contents of the string are split into arguments using a call to
+C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
+global C<@ARGV> is not touched.
+
+It is possible that, upon completion, not all arguments in the string
+have been processed. C<GetOptionsFromString> will, when called in list
+context, return both the return status and an array reference to any
+remaining arguments:
+
+    ($ret, $args) = GetOptionsFromString($string, ... );
+
+If any arguments remain, and C<GetOptionsFromString> was not called in
+list context, a message will be given and C<GetOptionsFromString> will
+return failure.
+
+=head2 Storing options values in a hash
+
+Sometimes, for example when there are a lot of options, having a
+separate variable for each of them can be cumbersome. GetOptions()
+supports, as an alternative mechanism, storing options values in a
+hash.
+
+To obtain this, a reference to a hash must be passed I<as the first
+argument> to GetOptions(). For each option that is specified on the
+command line, the option value will be stored in the hash with the
+option name as key. Options that are not actually used on the command
+line will not be put in the hash, on other words,
+C<exists($h{option})> (or defined()) can be used to test if an option
+was used. The drawback is that warnings will be issued if the program
+runs under C<use strict> and uses C<$h{option}> without testing with
+exists() or defined() first.
+
+    my %h = ();
+    GetOptions (\%h, 'length=i');	# will store in $h{length}
+
+For options that take list or hash values, it is necessary to indicate
+this by appending an C<@> or C<%> sign after the type:
+
+    GetOptions (\%h, 'colours=s@');	# will push to @{$h{colours}}
+
+To make things more complicated, the hash may contain references to
+the actual destinations, for example:
+
+    my $len = 0;
+    my %h = ('length' => \$len);
+    GetOptions (\%h, 'length=i');	# will store in $len
+
+This example is fully equivalent with:
+
+    my $len = 0;
+    GetOptions ('length=i' => \$len);	# will store in $len
+
+Any mixture is possible. For example, the most frequently used options
+could be stored in variables while all other options get stored in the
+hash:
+
+    my $verbose = 0;			# frequently referred
+    my $debug = 0;			# frequently referred
+    my %h = ('verbose' => \$verbose, 'debug' => \$debug);
+    GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
+    if ( $verbose ) { ... }
+    if ( exists $h{filter} ) { ... option 'filter' was specified ... }
+
+=head2 Bundling
+
+With bundling it is possible to set several single-character options
+at once. For example if C<a>, C<v> and C<x> are all valid options,
+
+    -vax
+
+would set all three.
+
+Getopt::Long supports two levels of bundling. To enable bundling, a
+call to Getopt::Long::Configure is required.
+
+The first level of bundling can be enabled with:
+
+    Getopt::Long::Configure ("bundling");
+
+Configured this way, single-character options can be bundled but long
+options B<must> always start with a double dash C<--> to avoid
+ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
+options,
+
+    -vax
+
+would set C<a>, C<v> and C<x>, but
+
+    --vax
+
+would set C<vax>.
+
+The second level of bundling lifts this restriction. It can be enabled
+with:
+
+    Getopt::Long::Configure ("bundling_override");
+
+Now, C<-vax> would set the option C<vax>.
+
+When any level of bundling is enabled, option values may be inserted
+in the bundle. For example:
+
+    -h24w80
+
+is equivalent to
+
+    -h 24 -w 80
+
+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,
+use:
+
+    Getopt::Long::Configure ("bundling", "ignorecase_always");
+
+It goes without saying that bundling can be quite confusing.
+
+=head2 The lonesome dash
+
+Normally, a lone dash C<-> on the command line will not be considered
+an option. Option processing will terminate (unless "permute" is
+configured) and the dash will be left in C<@ARGV>.
+
+It is possible to get special treatment for a lone dash. This can be
+achieved by adding an option specification with an empty name, for
+example:
+
+    GetOptions ('' => \$stdio);
+
+A lone dash on the command line will now be a legal option, and using
+it will set variable C<$stdio>.
+
+=head2 Argument callback
+
+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.
+
+For example:
+
+    my $width = 80;
+    sub process { ... }
+    GetOptions ('width=i' => \$width, '<>' => \&process);
+
+When applied to the following command line:
+
+    arg1 --width=72 arg2 --width=60 arg3
+
+This will call
+C<process("arg1")> while C<$width> is C<80>,
+C<process("arg2")> while C<$width> is C<72>, and
+C<process("arg3")> while C<$width> is C<60>.
+
+This feature requires configuration option B<permute>, see section
+L<Configuring Getopt::Long>.
+
+=head1 Configuring Getopt::Long
+
+Getopt::Long can be configured by calling subroutine
+Getopt::Long::Configure(). This subroutine takes a list of quoted
+strings, each specifying a configuration option to be enabled, e.g.
+C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
+matter. Multiple calls to Configure() are possible.
+
+Alternatively, as of version 2.24, the configuration options may be
+passed together with the C<use> statement:
+
+    use Getopt::Long qw(:config no_ignore_case bundling);
+
+The following options are available:
+
+=over 12
+
+=item default
+
+This option causes all configuration options to be reset to their
+default values.
+
+=item posix_default
+
+This option causes all configuration options to be reset to their
+default values as if the environment variable POSIXLY_CORRECT had
+been set.
+
+=item auto_abbrev
+
+Allow option names to be abbreviated to uniqueness.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
+
+=item getopt_compat
+
+Allow C<+> to start options.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
+
+=item gnu_compat
+
+C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
+do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
+C<--opt=> will give option C<opt> and empty value.
+This is the way GNU getopt_long() does it.
+
+=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().
+
+=item require_order
+
+Whether command line arguments are allowed to be mixed with options.
+Default is disabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
+
+See also C<permute>, which is the opposite of C<require_order>.
+
+=item permute
+
+Whether command line arguments are allowed to be mixed with options.
+Default is enabled unless environment variable
+POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
+Note that C<permute> is the opposite of C<require_order>.
+
+If C<permute> is enabled, this means that
+
+    --foo arg1 --bar arg2 arg3
+
+is equivalent to
+
+    --foo --bar arg1 arg2 arg3
+
+If an argument callback routine is specified, C<@ARGV> will always be
+empty upon successful return of GetOptions() since all options have been
+processed. The only exception is when C<--> is used:
+
+    --foo arg1 --bar arg2 -- arg3
+
+This will call the callback routine for arg1 and arg2, and then
+terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
+
+If C<require_order> is enabled, options processing
+terminates when the first non-option is encountered.
+
+    --foo arg1 --bar arg2 arg3
+
+is equivalent to
+
+    --foo -- arg1 --bar arg2 arg3
+
+If C<pass_through> is also enabled, options processing will terminate
+at the first unrecognized option, or non-option, whichever comes
+first.
+
+=item bundling (default: disabled)
+
+Enabling this option will allow single-character options to be
+bundled. To distinguish bundles from long option names, long options
+I<must> be introduced with C<--> and bundles with C<->.
+
+Note that, if you have options C<a>, C<l> and C<all>, and
+auto_abbrev enabled, possible arguments and option settings are:
+
+    using argument               sets option(s)
+    ------------------------------------------
+    -a, --a                      a
+    -l, --l                      l
+    -al, -la, -ala, -all,...     a, l
+    --al, --all                  all
+
+The surprising part is that C<--a> sets option C<a> (due to auto
+completion), not C<all>.
+
+Note: disabling C<bundling> also disables C<bundling_override>.
+
+=item bundling_override (default: disabled)
+
+If C<bundling_override> is enabled, bundling is enabled as with
+C<bundling> but now long option names override option bundles.
+
+Note: disabling C<bundling_override> also disables C<bundling>.
+
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
+
+=item ignore_case  (default: enabled)
+
+If enabled, case is ignored when matching long option names. If,
+however, bundling is enabled as well, single character options will be
+treated case-sensitive.
+
+With C<ignore_case>, option specifications for options that only
+differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
+duplicates.
+
+Note: disabling C<ignore_case> also disables C<ignore_case_always>.
+
+=item ignore_case_always (default: disabled)
+
+When bundling is in effect, case is ignored on single-character
+options also.
+
+Note: disabling C<ignore_case_always> also disables C<ignore_case>.
+
+=item auto_version (default:disabled)
+
+Automatically provide support for the B<--version> option if
+the application did not specify a handler for this option itself.
+
+Getopt::Long will provide a standard version message that includes the
+program name, its version (if $main::VERSION is defined), and the
+versions of Getopt::Long and Perl. The message will be written to
+standard output and processing will terminate.
+
+C<auto_version> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+C<require> statement.
+
+=item auto_help (default:disabled)
+
+Automatically provide support for the B<--help> and B<-?> options if
+the application did not specify a handler for this option itself.
+
+Getopt::Long will provide a help message using module L<Pod::Usage>. The
+message, derived from the SYNOPSIS POD section, will be written to
+standard output and processing will terminate.
+
+C<auto_help> will be enabled if the calling program explicitly
+specified a version number higher than 2.32 in the C<use> or
+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
+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.
+
+Note that the options terminator (default C<-->), if present, will
+also be passed through in C<@ARGV>.
+
+=item prefix
+
+The string that starts options. If a constant string is not
+sufficient, see C<prefix_pattern>.
+
+=item prefix_pattern
+
+A Perl pattern that identifies the strings that introduce options.
+Default is C<--|-|\+> unless environment variable
+POSIXLY_CORRECT has been set, in which case it is C<--|->.
+
+=item long_prefix_pattern
+
+A Perl pattern that allows the disambiguation of long and short
+prefixes. Default is C<-->.
+
+Typically you only need to set this if you are using nonstandard
+prefixes and want some or all of them to have the same semantics as
+'--' does under normal circumstances.
+
+For example, setting prefix_pattern to C<--|-|\+|\/> and
+long_prefix_pattern to C<--|\/> would add Win32 style argument
+handling.
+
+=item debug (default: disabled)
+
+Enable debugging output.
+
+=back
+
+=head1 Exportable Methods
+
+=over
+
+=item VersionMessage
+
+This subroutine provides a standard version message. Its argument can be:
+
+=over 4
+
+=item *
+
+A string containing the text of a message to print I<before> printing
+the standard message.
+
+=item *
+
+A numeric value corresponding to the desired exit status.
+
+=item *
+
+A reference to a hash.
+
+=back
+
+If more than one argument is given then the entire argument list is
+assumed to be a hash.  If a hash is supplied (either as a reference or
+as a list) it should contain one or more elements with the following
+keys:
+
+=over 4
+
+=item C<-message>
+
+=item C<-msg>
+
+The text of a message to print immediately prior to printing the
+program's usage message.
+
+=item C<-exitval>
+
+The desired exit status to pass to the B<exit()> function.
+This should be an integer, or else the string "NOEXIT" to
+indicate that control should simply be returned without
+terminating the invoking process.
+
+=item C<-output>
+
+A reference to a filehandle, or the pathname of a file to which the
+usage message should be written. The default is C<\*STDERR> unless the
+exit value is less than 2 (in which case the default is C<\*STDOUT>).
+
+=back
+
+You cannot tie this routine directly to an option, e.g.:
+
+    GetOptions("version" => \&VersionMessage);
+
+Use this instead:
+
+    GetOptions("version" => sub { VersionMessage() });
+
+=item HelpMessage
+
+This subroutine produces a standard help message, derived from the
+program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
+arguments as VersionMessage(). In particular, you cannot tie it
+directly to an option, e.g.:
+
+    GetOptions("help" => \&HelpMessage);
+
+Use this instead:
+
+    GetOptions("help" => sub { HelpMessage() });
+
+=back
+
+=head1 Return values and Errors
+
+Configuration errors and errors in the option definitions are
+signalled using die() and will terminate the calling program unless
+the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
+}>, or die() was trapped using C<$SIG{__DIE__}>.
+
+GetOptions returns true to indicate success.
+It returns false when the function detected one or more errors during
+option parsing. These errors are signalled using warn() and can be
+trapped with C<$SIG{__WARN__}>.
+
+=head1 Legacy
+
+The earliest development of C<newgetopt.pl> started in 1990, with Perl
+version 4. As a result, its development, and the development of
+Getopt::Long, has gone through several stages. Since backward
+compatibility has always been extremely important, the current version
+of Getopt::Long still supports a lot of constructs that nowadays are
+no longer necessary or otherwise unwanted. This section describes
+briefly some of these 'features'.
+
+=head2 Default destinations
+
+When no destination is specified for an option, GetOptions will store
+the resultant value in a global variable named C<opt_>I<XXX>, where
+I<XXX> is the primary name of this option. When a progam executes
+under C<use strict> (recommended), these variables must be
+pre-declared with our() or C<use vars>.
+
+    our $opt_length = 0;
+    GetOptions ('length=i');	# will store in $opt_length
+
+To yield a usable Perl variable, characters that are not part of the
+syntax for variables are translated to underscores. For example,
+C<--fpp-struct-return> will set the variable
+C<$opt_fpp_struct_return>. Note that this variable resides in the
+namespace of the calling program, not necessarily C<main>. For
+example:
+
+    GetOptions ("size=i", "sizes=i@");
+
+with command line "-size 10 -sizes 24 -sizes 48" will perform the
+equivalent of the assignments
+
+    $opt_size = 10;
+    @opt_sizes = (24, 48);
+
+=head2 Alternative option starters
+
+A string of alternative option starter characters may be passed as the
+first argument (or the first argument after a leading hash reference
+argument).
+
+    my $len = 0;
+    GetOptions ('/', 'length=i' => $len);
+
+Now the command line may look like:
+
+    /length 24 -- arg
+
+Note that to terminate options processing still requires a double dash
+C<-->.
+
+GetOptions() will not interpret a leading C<< "<>" >> as option starters
+if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
+option starters, use C<< "><" >>. Confusing? Well, B<using a starter
+argument is strongly deprecated> anyway.
+
+=head2 Configuration variables
+
+Previous versions of Getopt::Long used variables for the purpose of
+configuring. Although manipulating these variables still work, it is
+strongly encouraged to use the C<Configure> routine that was introduced
+in version 2.17. Besides, it is much easier.
+
+=head1 Tips and Techniques
+
+=head2 Pushing multiple values in a hash option
+
+Sometimes you want to combine the best of hashes and arrays. For
+example, the command line:
+
+  --list add=first --list add=second --list add=third
+
+where each successive 'list add' option will push the value of add
+into array ref $list->{'add'}. The result would be like
+
+  $list->{add} = [qw(first second third)];
+
+This can be accomplished with a destination routine:
+
+  GetOptions('list=s%' =>
+               sub { push(@{$list{$_[1]}}, $_[2]) });
+
+=head1 Troubleshooting
+
+=head2 GetOptions does not return a false result when an option is not supplied
+
+That's why they're called 'options'.
+
+=head2 GetOptions does not split the command line correctly
+
+The command line is not split by GetOptions, but by the command line
+interpreter (CLI). On Unix, this is the shell. On Windows, it is
+COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
+
+It is important to know that these CLIs may behave different when the
+command line contains special characters, in particular quotes or
+backslashes. For example, with Unix shells you can use single quotes
+(C<'>) and double quotes (C<">) to group words together. The following
+alternatives are equivalent on Unix:
+
+    "two words"
+    'two words'
+    two\ words
+
+In case of doubt, insert the following statement in front of your Perl
+program:
+
+    print STDERR (join("|",@ARGV),"\n");
+
+to verify how your CLI passes the arguments to the program.
+
+=head2 Undefined subroutine &main::GetOptions called
+
+Are you running Windows, and did you write
+
+    use GetOpt::Long;
+
+(note the capital 'O')?
+
+=head2 How do I put a "-?" option into a Getopt::Long?
+
+You can only obtain this using an alias, and Getopt::Long of at least
+version 2.13.
+
+    use Getopt::Long;
+    GetOptions ("help|?");    # -help and -? will both set $opt_help
+
+=head1 AUTHOR
+
+Johan Vromans <jvromans@squirrel.nl>
+
+=head1 COPYRIGHT AND DISCLAIMER
+
+This program is Copyright 1990,2009 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
+Foundation; either version 2 of the License, or (at your option) any
+later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+If you do not have a copy of the GNU General Public License write to
+the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
+MA 02139, USA.
+
+=cut
+
diff --git a/cpan/Getopt-Long/t/gol-basic.t b/cpan/Getopt-Long/t/gol-basic.t
new file mode 100644
index 0000000000..1ad5b75ac5
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-basic.t
@@ -0,0 +1,31 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long qw(:config no_ignore_case);
+my $want_version="2.24";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print (GetOptions("foo", "Foo=s") ? "" : "not ", "ok 1\n");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/cpan/Getopt-Long/t/gol-compat.t b/cpan/Getopt-Long/t/gol-compat.t
new file mode 100644
index 0000000000..fe4f746194
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-compat.t
@@ -0,0 +1,39 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+{
+    # Silence the deprecation warnings from newgetopt.pl for the purpose
+    # of testing. These tests will be removed along with newgetopt.pl in
+    # the next major release of perl.
+    local $SIG{__WARN__} = sub {
+        if ($_[0] !~ /deprecated/) {
+            print(STDERR @_);
+        }
+    };
+    require "newgetopt.pl";
+}
+
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+$newgetopt::ignorecase = 0;
+$newgetopt::ignorecase = 0;
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if NGetOpt ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/cpan/Getopt-Long/t/gol-linkage.t b/cpan/Getopt-Long/t/gol-linkage.t
new file mode 100644
index 0000000000..df975c8b31
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-linkage.t
@@ -0,0 +1,93 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long;
+
+print "1..33\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("no_ignore_case");
+%lnk = ();
+print "ok 1\n" if GetOptions (\%lnk, "foo", "Foo=s");
+print ((defined $lnk{foo})   ? "" : "not ", "ok 2\n");
+print (($lnk{foo} == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 4\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 7\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 8\n");
+
+@ARGV = qw(-Foo -baR --foo bar);
+Getopt::Long::Configure ("default","no_ignore_case");
+%lnk = ();
+my $foo;
+print "ok 9\n" if GetOptions (\%lnk, "foo" => \$foo, "Foo=s");
+print ((defined $foo)        ? "" : "not ", "ok 10\n");
+print (($foo == 1)           ? "" : "not ", "ok 11\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 12\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 13\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 14\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 15\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 16\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 17\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 18\n");
+
+@ARGV = qw(/Foo=-baR --bar bar);
+Getopt::Long::Configure ("default","prefix_pattern=--|/|-|\\+","long_prefix_pattern=--|/");
+%lnk = ();
+my $bar;
+print "ok 19\n" if GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+print ((defined $bar)        ? "" : "not ", "ok 20\n");
+print (($bar == 1)           ? "" : "not ", "ok 21\n");
+print ((defined $lnk{Foo})   ? "" : "not ", "ok 22\n");
+print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 23\n");
+print ((@ARGV == 1)          ? "" : "not ", "ok 24\n");
+print (($ARGV[0] eq "bar")   ? "" : "not ", "ok 25\n");
+print (!(exists $lnk{foo})   ? "" : "not ", "ok 26\n");
+print (!(exists $lnk{baR})   ? "" : "not ", "ok 27\n");
+print (!(exists $lnk{bar})   ? "" : "not ", "ok 28\n");
+{
+    my $errors;
+    %lnk = ();
+    local $SIG{__WARN__}= sub { $errors.=join("\n",@_,'') };
+
+    @ARGV = qw(/Foo=-baR);
+    Getopt::Long::Configure ("default","bundling","ignore_case_always",
+                             "prefix_pattern=--|/|-|\\+","long_prefix_pattern=--");
+    %lnk = ();
+    undef $bar;
+    GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+    print (($errors=~/Unknown option:/) ? "" : "not ", "ok 29\n");
+    $errors="";
+    %lnk = ();
+    undef $bar;
+     @ARGV = qw(/Foo=-baR);
+    Getopt::Long::Configure ("default","bundling","ignore_case_always",
+                             "prefix_pattern=--|/|-|\\+","long_prefix_pattern=--|/");
+    GetOptions (\%lnk, "bar" => \$bar, "Foo=s");
+    print (($errors eq '') ? "" : "not ", "ok 30\n");
+    print ((defined $lnk{Foo})   ? "" : "not ", "ok 31\n");
+    print (($lnk{Foo} eq "-baR") ? "" : "not ", "ok 32\n");
+}
+
+{
+    # Allow hashes to overload "".
+    # This used to fail up to 2.34.
+    # Thanks to Yves Orton.
+    my $blessed = bless(\%lnk, "OverLoad::Test");
+
+    @ARGV = qw(--foo bar);
+    Getopt::Long::Configure("default");
+    print "not" unless GetOptions (\%lnk, "foo=s" => \$foo);
+    print "ok 33\n";
+    package Overload::Test;
+    use overload '""' => sub{ die "Bad mojo!" };
+}
diff --git a/cpan/Getopt-Long/t/gol-oo.t b/cpan/Getopt-Long/t/gol-oo.t
new file mode 100644
index 0000000000..df49cb63b2
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-oo.t
@@ -0,0 +1,31 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long;
+my $want_version="2.24";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+print "1..9\n";
+
+@ARGV = qw(-Foo -baR --foo bar);
+my $p = new Getopt::Long::Parser (config => ["no_ignore_case"]);
+undef $opt_baR;
+undef $opt_bar;
+print "ok 1\n" if $p->getoptions ("foo", "Foo=s");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@ARGV == 1)         ? "" : "not ", "ok 6\n");
+print (($ARGV[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
diff --git a/cpan/Getopt-Long/t/gol-xargv.t b/cpan/Getopt-Long/t/gol-xargv.t
new file mode 100644
index 0000000000..52294e8727
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-xargv.t
@@ -0,0 +1,33 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case);
+my $want_version="2.3501";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..10\n";
+
+my @argv = qw(-Foo -baR --foo bar);
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print (GetOptionsFromArray(\@argv, "foo", "Foo=s") ? "" : "not ", "ok 1\n");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print ((@argv == 1)         ? "" : "not ", "ok 6\n");
+print (($argv[0] eq "bar")  ? "" : "not ", "ok 7\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 8\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 9\n");
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 10\n");
diff --git a/cpan/Getopt-Long/t/gol-xstring.t b/cpan/Getopt-Long/t/gol-xstring.t
new file mode 100644
index 0000000000..0d63191383
--- /dev/null
+++ b/cpan/Getopt-Long/t/gol-xstring.t
@@ -0,0 +1,54 @@
+#!./perl -w
+
+no strict;
+
+BEGIN {
+    if ($ENV{PERL_CORE}) {
+	@INC = '../lib';
+	chdir 't';
+    }
+}
+
+use Getopt::Long qw(GetOptionsFromString :config no_ignore_case);
+my $want_version="2.3501";
+die("Getopt::Long version $want_version required--this is only version ".
+    $Getopt::Long::VERSION)
+  unless $Getopt::Long::VERSION ge $want_version;
+
+print "1..14\n";
+
+my $args = "-Foo -baR --foo";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+print (GetOptionsFromString($args, "foo", "Foo=s") ? "" : "not ", "ok 1\n");
+print ((defined $opt_foo)   ? "" : "not ", "ok 2\n");
+print (($opt_foo == 1)      ? "" : "not ", "ok 3\n");
+print ((defined $opt_Foo)   ? "" : "not ", "ok 4\n");
+print (($opt_Foo eq "-baR") ? "" : "not ", "ok 5\n");
+print (!(defined $opt_baR)  ? "" : "not ", "ok 6\n");
+print (!(defined $opt_bar)  ? "" : "not ", "ok 7\n");
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 8\n");
+
+$args = "-Foo -baR blech --foo bar";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+{ my $msg = "";
+  local $SIG{__WARN__} = sub { $msg .= "@_" };
+  my $ret = GetOptionsFromString($args, "foo", "Foo=s");
+  print ($ret ? "not " : "ok 9\n");
+  print ($msg =~ /^GetOptionsFromString: Excess data / ? "" : "$msg\nnot ", "ok 10\n");
+}
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 11\n");
+
+$args = "-Foo -baR blech --foo bar";
+@ARGV = qw(foo bar);
+undef $opt_baR;
+undef $opt_bar;
+{ my $ret;
+  ($ret, $args) = GetOptionsFromString($args, "foo", "Foo=s");
+  print ($ret ? "" : "not ", "ok 12\n");
+  print ("@$args" eq "blech bar" ? "" : "@$args\nnot ", "ok 13\n");
+}
+print ("@ARGV" eq "foo bar" ? "" : "not ", "ok 14\n");