From: Johan Vromans <jvromans@squirrel.nl>
Date: Tue, 6 Jan 1998 16:21:45 +0000 (+0100)
Subject: Version 2.13 of GetoptLong:
X-Git-Tag: accepted/trunk/20130322.191538~37923
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=bb40d3782261f7375a463aaba51719e497fbb48f;p=platform%2Fupstream%2Fperl.git

Version 2.13 of GetoptLong:
	Subject: Re: ANNOUNCE: perl 5.004_56 is available

p4raw-id: //depot/perl@401
---

diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm
index 2b05300..38b3967 100644
--- a/lib/Getopt/Long.pm
+++ b/lib/Getopt/Long.pm
@@ -2,125 +2,870 @@
 
 package Getopt::Long;
 
-# RCS Status      : $Id: GetoptLong.pm,v 2.11 1997-09-17 12:23:51+02 jv Exp $
+# RCS Status      : $Id: GetoptLong.pm,v 2.13 1997-12-25 16:20:17+01 jv Exp $
 # Author          : Johan Vromans
 # Created On      : Tue Sep 11 15:00:12 1990
 # Last Modified By: Johan Vromans
-# Last Modified On: Wed Sep 17 12:20:10 1997
-# Update Count    : 608
+# Last Modified On: Thu Dec 25 16:18:08 1997
+# Update Count    : 647
 # Status          : Released
 
-=head1 NAME
-
-GetOptions - extended processing of command line options
-
-=head1 SYNOPSIS
-
-  use Getopt::Long;
-  $result = GetOptions (...option-descriptions...);
-
-=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. For example, the UNIX "ps" command can be
-given the command line "option"
-
-  -vax
-
-which means the combination of B<-v>, B<-a> and B<-x>. With the new
-syntax B<--vax> would be a single option, probably indicating a
-computer architecture. 
-
-Command line options can be used to set values. These values can be
-specified in one of two ways:
-
-  --size 24
-  --size=24
+################ Copyright ################
 
-GetOptions is called with a list of option-descriptions, each of which
-consists of two elements: the option specifier and the option linkage.
-The option specifier defines the name of the option and, optionally,
-the value it can take. The option linkage is usually a reference to a
-variable that will be set when the option is used. For example, the
-following call to GetOptions:
+# This program is Copyright 1990,1997 by Johan Vromans.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of 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.
 
-  GetOptions("size=i" => \$offset);
+################ Module Preamble ################
 
-will accept a command line option "size" that must have an integer
-value. With a command line of "--size 24" this will cause the variable
-$offset to get the value 24.
+use strict;
 
-Alternatively, the first argument to GetOptions may be a reference to
-a HASH describing the linkage for the options, or an object whose
-class is based on a HASH. The following call is equivalent to the
-example above:
+BEGIN {
+    require 5.003;
+    use Exporter ();
+    use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+    $VERSION   = sprintf("%d.%02d", q$Revision: 2.13 $ =~ /(\d+)\.(\d+)/);
 
-  %optctl = ("size" => \$offset);
-  GetOptions(\%optctl, "size=i");
+    @ISA       = qw(Exporter);
+    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
+    %EXPORT_TAGS = ();
+    @EXPORT_OK = qw();
+}
 
-Linkage may be specified using either of the above methods, or both.
-Linkage specified in the argument list takes precedence over the
-linkage specified in the HASH.
+use vars @EXPORT, @EXPORT_OK;
+# User visible variables.
+use vars qw($error $debug $major_version $minor_version);
+# Deprecated visible variables.
+use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
+	    $passthrough);
 
-The command line options are taken from array @ARGV. Upon completion
-of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
-the command line.
- 
-Each option specifier designates the name of the option, optionally
-followed by an argument specifier. Values for argument specifiers are:
+################ Local Variables ################
 
-=over 8
+my $gen_prefix;			# generic prefix (option starters)
+my $argend;			# option list terminator
+my %opctl;			# table of arg.specs (long and abbrevs)
+my %bopctl;			# table of arg.specs (bundles)
+my @opctl;			# the possible long option names
+my $pkg;			# current context. Needed if no linkage.
+my %aliases;			# alias table
+my $genprefix;			# so we can call the same module more 
+my $opt;			# current option
+my $arg;			# current option value, if any
+my $array;			# current option is array typed
+my $hash;			# current option is hash typed
+my $key;			# hash key for a hash option
+				# than once in differing environments
+my $config_defaults;		# set config defaults
+my $find_option;		# helper routine
+my $croak;			# helper routine
 
-=item E<lt>noneE<gt>
+################ Subroutines ################
 
-Option does not take an argument. 
-The option variable will be set to 1.
+sub GetOptions {
 
-=item !
+    my @optionlist = @_;	# local copy of the option descriptions
+    $argend = '--';		# option list terminator
+    %opctl = ();		# table of arg.specs (long and abbrevs)
+    %bopctl = ();		# table of arg.specs (bundles)
+    $pkg = (caller)[0];		# current context
+				# Needed if linkage is omitted.
+    %aliases= ();		# alias table
+    my @ret = ();		# accum for non-options
+    my %linkage;		# linkage
+    my $userlinkage;		# user supplied HASH
+    $genprefix = $gen_prefix;	# so we can call the same module many times
+    $error = '';
 
-Option does not take an argument and may be negated, i.e. prefixed by
-"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
-(with value 0).
-The option variable will be set to 1, or 0 if negated.
+    print STDERR ('GetOptions $Revision: 2.13 $ ',
+		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
+		  "called from package \"$pkg\".\n",
+		  "  (@ARGV)\n",
+		  "  autoabbrev=$autoabbrev".
+		  ",bundling=$bundling",
+		  ",getopt_compat=$getopt_compat",
+		  ",order=$order",
+		  ",\n  ignorecase=$ignorecase",
+		  ",passthrough=$passthrough",
+		  ",genprefix=\"$genprefix\"",
+		  ".\n")
+	if $debug;
 
-=item =s
+    # 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 ( ref($optionlist[0]) and
+	 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
+	$userlinkage = shift (@optionlist);
+	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
+    }
 
-Option takes a mandatory string argument.
-This string will be assigned to the option variable.
-Note that even if the string argument starts with B<-> or B<-->, it
-will not be considered an option on itself.
+    # See if the first element of the optionlist contains option
+    # starter characters.
+    if ( $optionlist[0] =~ /^\W+$/ ) {
+	$genprefix = shift (@optionlist);
+	# Turn into regexp. Needs to be parenthesized!
+	$genprefix =~ s/(\W)/\\$1/g;
+	$genprefix = "([" . $genprefix . "])";
+    }
 
-=item :s
+    # Verify correctness of optionlist.
+    %opctl = ();
+    %bopctl = ();
+    while ( @optionlist > 0 ) {
+	my $opt = shift (@optionlist);
 
-Option takes an optional string argument.
-This string will be assigned to the option variable.
-If omitted, it will be assigned "" (an empty string).
-If the string argument starts with B<-> or B<-->, it
-will be considered an option on itself.
+	# Strip leading prefix so people can specify "--foo=i" if they like.
+	$opt = $2 if $opt =~ /^$genprefix+(.*)$/;
 
-=item =i
+	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";
+		next;
+	    }
+	    $linkage{'<>'} = shift (@optionlist);
+	    next;
+	}
 
-Option takes a mandatory integer argument.
-This value will be assigned to the option variable.
-Note that the value may start with B<-> to indicate a negative
-value. 
+	# Match option spec. Allow '?' as an alias.
+	if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?(!|[=:][infse][@%]?)?$/ ) {
+	    $error .= "Error in option spec: \"$opt\"\n";
+	    next;
+	}
+	my ($o, $c, $a) = ($1, $5);
+	$c = '' unless defined $c;
 
-=item :i
+	if ( ! defined $o ) {
+	    # empty -> '-' option
+	    $opctl{$o = ''} = $c;
+	}
+	else {
+	    # Handle alias names
+	    my @o =  split (/\|/, $o);
+	    my $linko = $o = $o[0];
+	    # Force an alias if the option name is not locase.
+	    $a = $o unless $o eq lc($o);
+	    $o = lc ($o)
+		if $ignorecase > 1 
+		    || ($ignorecase
+			&& ($bundling ? length($o) > 1  : 1));
 
-Option takes an optional integer argument.
-This value will be assigned to the option variable.
-If omitted, the value 0 will be assigned.
-Note that the value may start with B<-> to indicate a negative
-value.
+	    foreach ( @o ) {
+		if ( $bundling && length($_) == 1 ) {
+		    $_ = lc ($_) if $ignorecase > 1;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			warn ("Ignoring '!' modifier for short option $_\n");
+			$c = '';
+		    }
+		    $opctl{$_} = $bopctl{$_} = $c;
+		}
+		else {
+		    $_ = lc ($_) if $ignorecase;
+		    if ( $c eq '!' ) {
+			$opctl{"no$_"} = $c;
+			$c = '';
+		    }
+		    $opctl{$_} = $c;
+		}
+		if ( defined $a ) {
+		    # Note alias.
+		    $aliases{$_} = $a;
+		}
+		else {
+		    # Set primary name.
+		    $a = $_;
+		}
+	    }
+	    $o = $linko;
+	}
 
-=item =f
+	# 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->{$o} && ref($userlinkage->{$o}) ) {
+		    print STDERR ("=> found userlinkage for \"$o\": ",
+				  "$userlinkage->{$o}\n")
+			if $debug;
+		    unshift (@optionlist, $userlinkage->{$o});
+		}
+		else {
+		    # Do nothing. Being undefined will be handled later.
+		    next;
+		}
+	    }
+	}
 
-Option takes a mandatory real number argument.
+	# Copy the linkage. If omitted, link to global variable.
+	if ( @optionlist > 0 && ref($optionlist[0]) ) {
+	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
+		if $debug;
+	    if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+	    }
+	    elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '@'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
+		$bopctl{$o} .= '@'
+		  if $bundling and defined $bopctl{$o} and 
+		    $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
+	    }
+	    elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
+		$linkage{$o} = shift (@optionlist);
+		$opctl{$o} .= '%'
+		  if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
+		$bopctl{$o} .= '%'
+		  if $bundling and defined $bopctl{$o} and 
+		    $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
+	    }
+	    else {
+		$error .= "Invalid option linkage for \"$opt\"\n";
+	    }
+	}
+	else {
+	    # Link to global $opt_XXX variable.
+	    # Make sure a valid perl identifier results.
+	    my $ov = $o;
+	    $ov =~ s/\W/_/g;
+	    if ( $c =~ /@/ ) {
+		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
+	    }
+	    elsif ( $c =~ /%/ ) {
+		print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
+	    }
+	    else {
+		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
+		    if $debug;
+		eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
+	    }
+	}
+    }
+
+    # Bail out if errors found.
+    die ($error) if $error;
+    $error = 0;
+
+    # Sort the possible long option names.
+    @opctl = sort(keys (%opctl)) if $autoabbrev;
+
+    # Show the options tables if debugging.
+    if ( $debug ) {
+	my ($arrow, $k, $v);
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%opctl) ) {
+	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+	$arrow = "=> ";
+	while ( ($k,$v) = each(%bopctl) ) {
+	    print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
+	    $arrow = "   ";
+	}
+    }
+
+    # Process argument list
+    while ( @ARGV > 0 ) {
+
+	#### Get next argument ####
+
+	$opt = shift (@ARGV);
+	$arg = undef;
+	$array = $hash = 0;
+	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+
+	#### Determine what we have ####
+
+	# Double dash is option list terminator.
+	if ( $opt eq $argend ) {
+	    # Finish. Push back accumulated arguments and return.
+	    unshift (@ARGV, @ret) 
+		if $order == $PERMUTE;
+	    return ($error == 0);
+	}
+
+	my $tryopt = $opt;
+
+	# find_option operates on the GLOBAL $opt and $arg!
+	if ( &$find_option () ) {
+	    
+	    # find_option undefines $opt in case of errors.
+	    next unless defined $opt;
+
+	    if ( defined $arg ) {
+		$opt = $aliases{$opt} if defined $aliases{$opt};
+
+		if ( defined $linkage{$opt} ) {
+		    print STDERR ("=> ref(\$L{$opt}) -> ",
+				  ref($linkage{$opt}), "\n") if $debug;
+
+		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
+			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\", \"$arg\")\n")
+			    if $debug;
+			&{$linkage{$opt}}($opt, $arg);
+		    }
+		    else {
+			print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
+				      "\" in linkage\n");
+			&$croak ("Getopt::Long -- internal error!\n");
+		    }
+		}
+		# No entry in linkage means entry in userlinkage.
+		elsif ( $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 ( $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 {
+		    print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
+		    $userlinkage->{$opt} = $arg;
+		}
+	    }
+	}
+
+	# 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{'<>'})) ) {
+		&$cb ($tryopt);
+	    }
+	    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 ( $order == $PERMUTE ) {
+	#  Push back accumulated arguments
+	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
+	    if $debug && @ret > 0;
+	unshift (@ARGV, @ret) if @ret > 0;
+    }
+
+    return ($error == 0);
+}
+
+sub config (@) {
+    my (@options) = @_;
+    my $opt;
+    foreach $opt ( @options ) {
+	my $try = lc ($opt);
+	my $action = 1;
+	if ( $try =~ /^no_?(.*)$/ ) {
+	    $action = 0;
+	    $try = $1;
+	}
+	if ( $try eq 'default' or $try eq 'defaults' ) {
+	    &$config_defaults () if $action;
+	}
+	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
+	    $autoabbrev = $action;
+	}
+	elsif ( $try eq 'getopt_compat' ) {
+	    $getopt_compat = $action;
+	}
+	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
+	    $ignorecase = $action;
+	}
+	elsif ( $try eq 'ignore_case_always' ) {
+	    $ignorecase = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'bundling' ) {
+	    $bundling = $action;
+	}
+	elsif ( $try eq 'bundling_override' ) {
+	    $bundling = $action ? 2 : 0;
+	}
+	elsif ( $try eq 'require_order' ) {
+	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
+	}
+	elsif ( $try eq 'permute' ) {
+	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
+	}
+	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
+	    $passthrough = $action;
+	}
+	elsif ( $try eq 'debug' ) {
+	    $debug = $action;
+	}
+	else {
+	    &$croak ("Getopt::Long: unknown config parameter \"$opt\"")
+	}
+    }
+}
+
+# To prevent Carp from being loaded unnecessarily.
+$croak = sub {
+    require 'Carp.pm';
+    $Carp::CarpLevel = 1;
+    Carp::croak(@_);
+};
+
+################ Private Subroutines ################
+
+$find_option = sub {
+
+    print STDERR ("=> find \"$opt\", genprefix=\"$genprefix\"\n") if $debug;
+
+    return 0 unless $opt =~ /^$genprefix(.*)$/;
+
+    $opt = $2;
+    my ($starter) = $1;
+
+    print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
+
+    my $optarg = undef;	# value supplied with --opt=value
+    my $rest = undef;	# remainder from unbundling
+
+    # If it is a long option, it may include the value.
+    if (($starter eq "--" || ($getopt_compat && !$bundling))
+	&& $opt =~ /^([^=]+)=(.*)$/ ) {
+	$opt = $1;
+	$optarg = $2;
+	print STDERR ("=> option \"", $opt, 
+		      "\", optarg = \"$optarg\"\n") if $debug;
+    }
+
+    #### Look it up ###
+
+    my $tryopt = $opt;		# option to try
+    my $optbl = \%opctl;	# table to look it up (long names)
+    my $type;
+
+    if ( $bundling && $starter eq '-' ) {
+	# Unbundle single letter option.
+	$rest = 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 '';
+	$optbl = \%bopctl;	# look it up in the short names table
+
+	# If bundling == 2, long options can override bundles.
+	if ( $bundling == 2 and
+	     defined ($type = $opctl{$tryopt.$rest}) ) {
+	    print STDERR ("=> $starter$tryopt rebundled to ",
+			  "$starter$tryopt$rest\n") if $debug;
+	    $tryopt .= $rest;
+	    undef $rest;
+	}
+    } 
+
+    # Try auto-abbreviation.
+    elsif ( $autoabbrev ) {
+	# Downcase if allowed.
+	$tryopt = $opt = lc ($opt) if $ignorecase;
+	# Turn option name into pattern.
+	my $pat = quotemeta ($opt);
+	# Look up in option names.
+	my @hits = grep (/^$pat/, @opctl);
+	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
+		      "out of ", scalar(@opctl), "\n") if $debug;
+
+	# Check for ambiguous results.
+	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
+	    # See if all matches are for the same option.
+	    my %hit;
+	    foreach ( @hits ) {
+		$_ = $aliases{$_} if defined $aliases{$_};
+		$hit{$_} = 1;
+	    }
+	    # Now see if it really is ambiguous.
+	    unless ( keys(%hit) == 1 ) {
+		return 0 if $passthrough;
+		warn ("Option ", $opt, " is ambiguous (",
+		      join(", ", @hits), ")\n");
+		$error++;
+		undef $opt;
+		return 1;
+	    }
+	    @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.
+    $type = $optbl->{$tryopt} unless defined $type;
+    unless  ( defined $type ) {
+	return 0 if $passthrough;
+	warn ("Unknown option: ", $opt, "\n");
+	$error++;
+	return 1;
+    }
+    # Apparently valid.
+    $opt = $tryopt;
+    print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+
+    #### Determine argument status ####
+
+    # If it is an option w/o argument, we're almost finished with it.
+    if ( $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 '' ) {
+	    $arg = 1;		# supply explicit value
+	}
+	else {
+	    substr ($opt, 0, 2) = ''; # strip NO prefix
+	    $arg = 0;		# supply explicit value
+	}
+	unshift (@ARGV, $starter.$rest) if defined $rest;
+	return 1;
+    }
+
+    # Get mandatory status and type info.
+    my $mand;
+    ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+
+    # Check if there is an option argument available.
+    if ( defined $optarg ? ($optarg eq '') 
+	 : !(defined $rest || @ARGV > 0) ) {
+	# Complain if this option needs an argument.
+	if ( $mand eq "=" ) {
+	    return 0 if $passthrough;
+	    warn ("Option ", $opt, " requires an argument\n");
+	    $error++;
+	    undef $opt;
+	}
+	if ( $mand eq ":" ) {
+	    $arg = $type eq "s" ? '' : 0;
+	}
+	return 1;
+    }
+
+    # 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.
+    $key = undef;
+    if ($hash && defined $arg) {
+	($key, $arg) = ($arg =~ /^(.*)=(.*)$/o) ? ($1, $2) : ($arg, 1);
+    }
+
+    #### Check if the argument is valid for this option ####
+
+    if ( $type eq "s" ) {	# string
+	# A mandatory string takes anything. 
+	return 1 if $mand eq "=";
+
+	# An optional string takes almost anything. 
+	return 1 if defined $optarg || defined $rest;
+	return 1 if $arg eq "-"; # ??
+
+	# Check for option or option list terminator.
+	if ($arg eq $argend ||
+	    $arg =~ /^$genprefix.+/) {
+	    # Push back.
+	    unshift (@ARGV, $arg);
+	    # Supply empty value.
+	    $arg = '';
+	}
+    }
+
+    elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
+	if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/ ) {
+	    $arg = $1;
+	    $rest = $2;
+	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg !~ /^-?[0-9]+$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		if ( $passthrough ) {
+		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
+		      unless defined $optarg;
+		    return 0;
+		}
+		warn ("Value \"", $arg, "\" invalid for option ",
+		      $opt, " (number expected)\n");
+		$error++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
+	    }
+	    else {
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 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]
+	if ( $bundling && defined $rest &&
+	     $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/ ) {
+	    $arg = $1;
+	    $rest = $4;
+	    unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
+	}
+	elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
+	    if ( defined $optarg || $mand eq "=" ) {
+		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++;
+		undef $opt;
+		# Push back.
+		unshift (@ARGV, $starter.$rest) if defined $rest;
+	    }
+	    else {
+		# Push back.
+		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
+		# Supply default value.
+		$arg = 0.0;
+	    }
+	}
+    }
+    else {
+	&$croak ("GetOpt::Long internal error (Can't happen)\n");
+    }
+    return 1;
+};
+
+$config_defaults = sub {
+    # Handle POSIX compliancy.
+    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
+	$gen_prefix = "(--|-)";
+	$autoabbrev = 0;		# no automatic abbrev of options
+	$bundling = 0;			# no bundling of single letter switches
+	$getopt_compat = 0;		# disallow '+' to start options
+	$order = $REQUIRE_ORDER;
+    }
+    else {
+	$gen_prefix = "(--|-|\\+)";
+	$autoabbrev = 1;		# automatic abbrev of options
+	$bundling = 0;			# bundling off by default
+	$getopt_compat = 1;		# allow '+' to start options
+	$order = $PERMUTE;
+    }
+    # Other configurable settings.
+    $debug = 0;			# for debugging
+    $error = 0;			# error tally
+    $ignorecase = 1;		# ignore case when matching options
+    $passthrough = 0;		# leave unrecognized options alone
+};
+
+################ Initialization ################
+
+# Values for $order. See GNU getopt.c for details.
+($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
+# Version major/minor numbers.
+($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
+
+# Set defaults.
+&$config_defaults ();
+
+################ Package return ################
+
+1;
+
+__END__
+
+=head1 NAME
+
+GetOptions - extended processing of command line options
+
+=head1 SYNOPSIS
+
+  use Getopt::Long;
+  $result = GetOptions (...option-descriptions...);
+
+=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. For example, the UNIX "ps" command can be
+given the command line "option"
+
+  -vax
+
+which means the combination of B<-v>, B<-a> and B<-x>. With the new
+syntax B<--vax> would be a single option, probably indicating a
+computer architecture. 
+
+Command line options can be used to set values. These values can be
+specified in one of two ways:
+
+  --size 24
+  --size=24
+
+GetOptions is called with a list of option-descriptions, each of which
+consists of two elements: the option specifier and the option linkage.
+The option specifier defines the name of the option and, optionally,
+the value it can take. The option linkage is usually a reference to a
+variable that will be set when the option is used. For example, the
+following call to GetOptions:
+
+  GetOptions("size=i" => \$offset);
+
+will accept a command line option "size" that must have an integer
+value. With a command line of "--size 24" this will cause the variable
+$offset to get the value 24.
+
+Alternatively, the first argument to GetOptions may be a reference to
+a HASH describing the linkage for the options, or an object whose
+class is based on a HASH. The following call is equivalent to the
+example above:
+
+  %optctl = ("size" => \$offset);
+  GetOptions(\%optctl, "size=i");
+
+Linkage may be specified using either of the above methods, or both.
+Linkage specified in the argument list takes precedence over the
+linkage specified in the HASH.
+
+The command line options are taken from array @ARGV. Upon completion
+of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
+the command line.
+ 
+Each option specifier designates the name of the option, optionally
+followed by an argument specifier.
+
+Options that do not take arguments will have no argument specifier. 
+The option variable will be set to 1 if the option is used.
+
+For the other options, the values for argument specifiers are:
+
+=over 8
+
+=item !
+
+Option does not take an argument and may be negated, i.e. prefixed by
+"no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
+(with value 0).
+The option variable will be set to 1, or 0 if negated.
+
+=item =s
+
+Option takes a mandatory string argument.
+This string will be assigned to the option variable.
+Note that even if the string argument starts with B<-> or B<-->, it
+will not be considered an option on itself.
+
+=item :s
+
+Option takes an optional string argument.
+This string will be assigned to the option variable.
+If omitted, it will be assigned "" (an empty string).
+If the string argument starts with B<-> or B<-->, it
+will be considered an option on itself.
+
+=item =i
+
+Option takes a mandatory integer argument.
+This value will be assigned to the option variable.
+Note that the value may start with B<-> to indicate a negative
+value. 
+
+=item :i
+
+Option takes an optional integer argument.
+This value will be assigned to the option variable.
+If omitted, the value 0 will be assigned.
+Note that the value may start with B<-> to indicate a negative
+value.
+
+=item =f
+
+Option takes a mandatory real number argument.
 This value will be assigned to the option variable.
 Note that the value may start with B<-> to indicate a negative
 value.
@@ -216,7 +961,8 @@ The option name is always the true name, not an abbreviation or alias.
 The option name may actually be a list of option names, separated by
 "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
 of this option. If no linkage is specified, options "foo", "bar" and
-"blech" all will set $opt_foo.
+"blech" all will set $opt_foo. For convenience, the single character
+"?" is allowed as an alias, e.g. "help|?".
 
 Option names may be abbreviated to uniqueness, depending on
 configuration option B<auto_abbrev>.
@@ -242,10 +988,20 @@ defined.
 Options that start with "--" may have an argument appended, separated
 with an "=", e.g. "--foo=bar".
 
-=head2 Return value
+=head2 Return values and Errors
+
+Configuration errors and errors in the option definitions are
+signalled using C<die()> and will terminate the calling
+program unless the call to C<Getopt::Long::GetOptions()> was embedded
+in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>.
+
+A return value of 1 (true) indicates success.
 
-A return status of 0 (false) indicates that the function detected
-one or more errors.
+A return status of 0 (false) indicates that the function detected one
+or more errors during option parsing. These errors are signalled using
+C<warn()> and can be trapped with C<$SIG{__WARN__}>.
+
+Errors that can't happen are signalled using C<Carp::croak()>.
 
 =head1 COMPATIBILITY
 
@@ -270,969 +1026,255 @@ CONFIGURATION OPTIONS), options that start with "+" or "-" may also
 include their arguments, e.g. "+foo=bar". This is for compatiblity
 with older implementations of the GNU "getopt" routine.
 
-If the first argument to GetOptions is a string consisting of only
-non-alphanumeric characters, it is taken to specify the option starter
-characters. Everything starting with one of these characters from the
-starter will be considered an option. B<Using a starter argument is
-strongly deprecated.>
-
-For convenience, option specifiers may have a leading B<-> or B<-->,
-so it is possible to write:
-
-   GetOptions qw(-foo=s --bar=i --ar=s);
-
-=head1 EXAMPLES
-
-If the option specifier is "one:i" (i.e. takes an optional integer
-argument), then the following situations are handled:
-
-   -one -two		-> $opt_one = '', -two is next option
-   -one -2		-> $opt_one = -2
-
-Also, assume specifiers "foo=s" and "bar:s" :
-
-   -bar -xxx		-> $opt_bar = '', '-xxx' is next option
-   -foo -bar		-> $opt_foo = '-bar'
-   -foo --		-> $opt_foo = '--'
-
-In GNU or POSIX format, option names and values can be combined:
-
-   +foo=blech		-> $opt_foo = 'blech'
-   --bar=		-> $opt_bar = ''
-   --bar=--		-> $opt_bar = '--'
-
-Example of using variable references:
-
-   $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
-
-With command line options "-foo blech -bar 24 -ar xx -ar yy" 
-this will result in:
-
-   $foo = 'blech'
-   $opt_bar = 24
-   @ar = ('xx','yy')
-
-Example of using the E<lt>E<gt> option specifier:
-
-   @ARGV = qw(-foo 1 bar -foo 2 blech);
-   GetOptions("foo=i", \$myfoo, "<>", \&mysub);
-
-Results:
-
-   mysub("bar") will be called (with $myfoo being 1)
-   mysub("blech") will be called (with $myfoo being 2)
-
-Compare this with:
-
-   @ARGV = qw(-foo 1 bar -foo 2 blech);
-   GetOptions("foo=i", \$myfoo);
-
-This will leave the non-options in @ARGV:
-
-   $myfoo -> 2
-   @ARGV -> qw(bar blech)
-
-=head1 CONFIGURATION OPTIONS
-
-B<GetOptions> can be configured by calling subroutine
-B<Getopt::Long::config>. This subroutine takes a list of quoted
-strings, each specifying a configuration option to be set, e.g.
-B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
-B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
-are possible.
-
-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 new B<config> routine. Besides, it
-is much easier.
-
-The following options are available:
-
-=over 12
-
-=item default
-
-This option causes all configuration options to be reset to their
-default values.
-
-=item auto_abbrev
-
-Allow option names to be abbreviated to uniqueness.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
-
-=item getopt_compat   
-
-Allow '+' to start options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
-
-=item require_order
-
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
-
-See also B<permute>, which is the opposite of B<require_order>.
-
-=item permute
-
-Whether non-options are allowed to be mixed with
-options.
-Default is set unless environment variable
-POSIXLY_CORRECT has been set, in which case B<permute> is reset.
-Note that B<permute> is the opposite of B<require_order>.
-
-If B<permute> is set, this means that 
-
-    -foo arg1 -bar arg2 arg3
-
-is equivalent to
-
-    -foo -bar arg1 arg2 arg3
-
-If a non-option call-back routine is specified, @ARGV will always be
-empty upon succesful return of GetOptions since all options have been
-processed, except when B<--> is used:
-
-    -foo arg1 -bar arg2 -- arg3
-
-will call the call-back routine for arg1 and arg2, and terminate
-leaving arg2 in @ARGV.
-
-If B<require_order> is set, options processing
-terminates when the first non-option is encountered.
-
-    -foo arg1 -bar arg2 arg3
-
-is equivalent to
-
-    -foo -- arg1 -bar arg2 arg3
-
-=item bundling (default: reset)
-
-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 B<--> and single-character
-options (and bundles) with B<->. For example,
-
-    ps -vax --vax
-
-would be equivalent to
-
-    ps -v -a -x --vax
-
-provided "vax", "v", "a" and "x" have been defined to be valid
-options. 
-
-Bundled options can also include a value in the bundle; this value has
-to be the last part of the bundle, e.g.
-
-    scale -h24 -w80
-
-is equivalent to
-
-    scale -h 24 -w 80
-
-Note: resetting B<bundling> also resets B<bundling_override>.
-
-=item bundling_override (default: reset)
-
-If B<bundling_override> is set, bundling is enabled as with
-B<bundling> but now long option names override option bundles. In the
-above example, B<-vax> would be interpreted as the option "vax", not
-the bundle "v", "a", "x".
-
-Note: resetting B<bundling_override> also resets B<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: set)
-
-If set, case is ignored when matching options.
-
-Note: resetting B<ignore_case> also resets B<ignore_case_always>.
-
-=item ignore_case_always (default: reset)
-
-When bundling is in effect, case is ignored on single-character
-options also. 
-
-Note: resetting B<ignore_case_always> also resets B<ignore_case>.
-
-=item pass_through (default: reset)
-
-Unknown options are passed through in @ARGV instead of being flagged
-as errors. This makes it possible to write wrapper scripts that
-process only part of the user supplied options, and passes the
-remaining options to some other program.
-
-This can be very confusing, especially when B<permute> is also set.
-
-=item debug (default: reset)
+If the first argument to GetOptions is a string consisting of only
+non-alphanumeric characters, it is taken to specify the option starter
+characters. Everything starting with one of these characters from the
+starter will be considered an option. B<Using a starter argument is
+strongly deprecated.>
 
-Enable copious debugging output.
+For convenience, option specifiers may have a leading B<-> or B<-->,
+so it is possible to write:
 
-=back
+   GetOptions qw(-foo=s --bar=i --ar=s);
 
-=head1 OTHER USEFUL VARIABLES
+=head1 EXAMPLES
 
-=over 12
+If the option specifier is "one:i" (i.e. takes an optional integer
+argument), then the following situations are handled:
 
-=item $Getopt::Long::VERSION
+   -one -two		-> $opt_one = '', -two is next option
+   -one -2		-> $opt_one = -2
 
-The version number of this Getopt::Long implementation in the format
-C<major>.C<minor>. This can be used to have Exporter check the
-version, e.g.
+Also, assume specifiers "foo=s" and "bar:s" :
 
-    use Getopt::Long 3.00;
+   -bar -xxx		-> $opt_bar = '', '-xxx' is next option
+   -foo -bar		-> $opt_foo = '-bar'
+   -foo --		-> $opt_foo = '--'
 
-You can inspect $Getopt::Long::major_version and
-$Getopt::Long::minor_version for the individual components.
+In GNU or POSIX format, option names and values can be combined:
 
-=item $Getopt::Long::error
+   +foo=blech		-> $opt_foo = 'blech'
+   --bar=		-> $opt_bar = ''
+   --bar=--		-> $opt_bar = '--'
 
-Internal error flag. May be incremented from a call-back routine to
-cause options parsing to fail.
+Example of using variable references:
 
-=back
+   $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
 
-=cut
+With command line options "-foo blech -bar 24 -ar xx -ar yy" 
+this will result in:
 
-################ Copyright ################
+   $foo = 'blech'
+   $opt_bar = 24
+   @ar = ('xx','yy')
 
-# This program is Copyright 1990,1997 by Johan Vromans.
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of 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.
+Example of using the E<lt>E<gt> option specifier:
 
-################ Module Preamble ################
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   GetOptions("foo=i", \$myfoo, "<>", \&mysub);
 
-use strict;
+Results:
 
-BEGIN {
-    require 5.003;
-    use Exporter ();
-    use vars   qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
-    $VERSION   = sprintf("%d.%02d", q$Revision: 2.11 $ =~ /(\d+)\.(\d+)/);
+   mysub("bar") will be called (with $myfoo being 1)
+   mysub("blech") will be called (with $myfoo being 2)
 
-    @ISA       = qw(Exporter);
-    @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
-    %EXPORT_TAGS = ();
-    @EXPORT_OK = qw();
-}
+Compare this with:
 
-use vars @EXPORT, @EXPORT_OK;
-# User visible variables.
-use vars qw($error $debug $major_version $minor_version);
-# Deprecated visible variables.
-use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
-	    $passthrough);
+   @ARGV = qw(-foo 1 bar -foo 2 blech);
+   GetOptions("foo=i", \$myfoo);
 
-################ Local Variables ################
+This will leave the non-options in @ARGV:
 
-my $gen_prefix;			# generic prefix (option starters)
-my $argend;			# option list terminator
-my %opctl;			# table of arg.specs (long and abbrevs)
-my %bopctl;			# table of arg.specs (bundles)
-my @opctl;			# the possible long option names
-my $pkg;			# current context. Needed if no linkage.
-my %aliases;			# alias table
-my $genprefix;			# so we can call the same module more 
-my $opt;			# current option
-my $arg;			# current option value, if any
-my $array;			# current option is array typed
-my $hash;			# current option is hash typed
-my $key;			# hash key for a hash option
-				# than once in differing environments
-my $config_defaults;		# set config defaults
-my $find_option;		# helper routine
+   $myfoo -> 2
+   @ARGV -> qw(bar blech)
 
-################ Subroutines ################
+=head1 CONFIGURATION OPTIONS
 
-sub GetOptions {
+B<GetOptions> can be configured by calling subroutine
+B<Getopt::Long::config>. This subroutine takes a list of quoted
+strings, each specifying a configuration option to be set, e.g.
+B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
+B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
+are possible.
 
-    my @optionlist = @_;	# local copy of the option descriptions
-    $argend = '--';		# option list terminator
-    %opctl = ();		# table of arg.specs (long and abbrevs)
-    %bopctl = ();		# table of arg.specs (bundles)
-    $pkg = (caller)[0];		# current context
-				# Needed if linkage is omitted.
-    %aliases= ();		# alias table
-    my @ret = ();		# accum for non-options
-    my %linkage;		# linkage
-    my $userlinkage;		# user supplied HASH
-    $genprefix = $gen_prefix;	# so we can call the same module many times
-    $error = 0;
+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 new B<config> routine. Besides, it
+is much easier.
 
-    print STDERR ('GetOptions $Revision: 2.11 $ ',
-		  "[GetOpt::Long $Getopt::Long::VERSION] -- ",
-		  "called from package \"$pkg\".\n",
-		  "  (@ARGV)\n",
-		  "  autoabbrev=$autoabbrev".
-		  ",bundling=$bundling",
-		  ",getopt_compat=$getopt_compat",
-		  ",order=$order",
-		  ",\n  ignorecase=$ignorecase",
-		  ",passthrough=$passthrough",
-		  ",genprefix=\"$genprefix\"",
-		  ".\n")
-	if $debug;
+The following options are available:
 
-    # 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 ( ref($optionlist[0]) and
-	 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
-	$userlinkage = shift (@optionlist);
-	print STDERR ("=> user linkage: $userlinkage\n") if $debug;
-    }
+=over 12
 
-    # See if the first element of the optionlist contains option
-    # starter characters.
-    if ( $optionlist[0] =~ /^\W+$/ ) {
-	$genprefix = shift (@optionlist);
-	# Turn into regexp.
-	$genprefix =~ s/(\W)/\\$1/g;
-	$genprefix = "[" . $genprefix . "]";
-    }
+=item default
 
-    # Verify correctness of optionlist.
-    %opctl = ();
-    %bopctl = ();
-    while ( @optionlist > 0 ) {
-	my $opt = shift (@optionlist);
+This option causes all configuration options to be reset to their
+default values.
 
-	# Strip leading prefix so people can specify "--foo=i" if they like.
-	$opt = $' if $opt =~ /^($genprefix)+/;
+=item auto_abbrev
 
-	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' ) {
-		warn ("Option spec <> requires a reference to a subroutine\n");
-		$error++;
-		next;
-	    }
-	    $linkage{'<>'} = shift (@optionlist);
-	    next;
-	}
+Allow option names to be abbreviated to uniqueness.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
 
-	if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) {
-	    warn ("Error in option spec: \"", $opt, "\"\n");
-	    $error++;
-	    next;
-	}
-	my ($o, $c, $a) = ($1, $2);
-	$c = '' unless defined $c;
+=item getopt_compat   
 
-	if ( ! defined $o ) {
-	    # empty -> '-' option
-	    $opctl{$o = ''} = $c;
-	}
-	else {
-	    # Handle alias names
-	    my @o =  split (/\|/, $o);
-	    my $linko = $o = $o[0];
-	    # Force an alias if the option name is not locase.
-	    $a = $o unless $o eq lc($o);
-	    $o = lc ($o)
-		if $ignorecase > 1 
-		    || ($ignorecase
-			&& ($bundling ? length($o) > 1  : 1));
+Allow '+' to start options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
 
-	    foreach ( @o ) {
-		if ( $bundling && length($_) == 1 ) {
-		    $_ = lc ($_) if $ignorecase > 1;
-		    if ( $c eq '!' ) {
-			$opctl{"no$_"} = $c;
-			warn ("Ignoring '!' modifier for short option $_\n");
-			$c = '';
-		    }
-		    $opctl{$_} = $bopctl{$_} = $c;
-		}
-		else {
-		    $_ = lc ($_) if $ignorecase;
-		    if ( $c eq '!' ) {
-			$opctl{"no$_"} = $c;
-			$c = '';
-		    }
-		    $opctl{$_} = $c;
-		}
-		if ( defined $a ) {
-		    # Note alias.
-		    $aliases{$_} = $a;
-		}
-		else {
-		    # Set primary name.
-		    $a = $_;
-		}
-	    }
-	    $o = $linko;
-	}
+=item require_order
 
-	# 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->{$o} && ref($userlinkage->{$o}) ) {
-		    print STDERR ("=> found userlinkage for \"$o\": ",
-				  "$userlinkage->{$o}\n")
-			if $debug;
-		    unshift (@optionlist, $userlinkage->{$o});
-		}
-		else {
-		    # Do nothing. Being undefined will be handled later.
-		    next;
-		}
-	    }
-	}
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
 
-	# Copy the linkage. If omitted, link to global variable.
-	if ( @optionlist > 0 && ref($optionlist[0]) ) {
-	    print STDERR ("=> link \"$o\" to $optionlist[0]\n")
-		if $debug;
-	    if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
-		$linkage{$o} = shift (@optionlist);
-	    }
-	    elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
-		$linkage{$o} = shift (@optionlist);
-		$opctl{$o} .= '@'
-		  if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
-		$bopctl{$o} .= '@'
-		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
-	    }
-	    elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
-		$linkage{$o} = shift (@optionlist);
-		$opctl{$o} .= '%'
-		  if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
-		$bopctl{$o} .= '%'
-		  if $bundling and $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
-	    }
-	    else {
-		warn ("Invalid option linkage for \"", $opt, "\"\n");
-		$error++;
-	    }
-	}
-	else {
-	    # Link to global $opt_XXX variable.
-	    # Make sure a valid perl identifier results.
-	    my $ov = $o;
-	    $ov =~ s/\W/_/g;
-	    if ( $c =~ /@/ ) {
-		print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
-		    if $debug;
-		eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
-	    }
-	    elsif ( $c =~ /%/ ) {
-		print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
-		    if $debug;
-		eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
-	    }
-	    else {
-		print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
-		    if $debug;
-		eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
-	    }
-	}
-    }
+See also B<permute>, which is the opposite of B<require_order>.
 
-    # Bail out if errors found.
-    return 0 if $error;
+=item permute
 
-    # Sort the possible long option names.
-    @opctl = sort(keys (%opctl)) if $autoabbrev;
+Whether non-options are allowed to be mixed with
+options.
+Default is set unless environment variable
+POSIXLY_CORRECT has been set, in which case B<permute> is reset.
+Note that B<permute> is the opposite of B<require_order>.
 
-    # Show the options tables if debugging.
-    if ( $debug ) {
-	my ($arrow, $k, $v);
-	$arrow = "=> ";
-	while ( ($k,$v) = each(%opctl) ) {
-	    print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
-	    $arrow = "   ";
-	}
-	$arrow = "=> ";
-	while ( ($k,$v) = each(%bopctl) ) {
-	    print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
-	    $arrow = "   ";
-	}
-    }
+If B<permute> is set, this means that 
 
-    # Process argument list
-    while ( @ARGV > 0 ) {
+    -foo arg1 -bar arg2 arg3
 
-	#### Get next argument ####
+is equivalent to
 
-	$opt = shift (@ARGV);
-	$arg = undef;
-	$array = $hash = 0;
-	print STDERR ("=> option \"", $opt, "\"\n") if $debug;
+    -foo -bar arg1 arg2 arg3
 
-	#### Determine what we have ####
+If a non-option call-back routine is specified, @ARGV will always be
+empty upon succesful return of GetOptions since all options have been
+processed, except when B<--> is used:
 
-	# Double dash is option list terminator.
-	if ( $opt eq $argend ) {
-	    # Finish. Push back accumulated arguments and return.
-	    unshift (@ARGV, @ret) 
-		if $order == $PERMUTE;
-	    return ($error == 0);
-	}
+    -foo arg1 -bar arg2 -- arg3
 
-	my $tryopt = $opt;
+will call the call-back routine for arg1 and arg2, and terminate
+leaving arg2 in @ARGV.
 
-	# find_option operates on the GLOBAL $opt and $arg!
-	if ( &$find_option () ) {
-	    
-	    # find_option undefines $opt in case of errors.
-	    next unless defined $opt;
+If B<require_order> is set, options processing
+terminates when the first non-option is encountered.
 
-	    if ( defined $arg ) {
-		$opt = $aliases{$opt} if defined $aliases{$opt};
+    -foo arg1 -bar arg2 arg3
 
-		if ( defined $linkage{$opt} ) {
-		    print STDERR ("=> ref(\$L{$opt}) -> ",
-				  ref($linkage{$opt}), "\n") if $debug;
+is equivalent to
 
-		    if ( ref($linkage{$opt}) eq 'SCALAR' ) {
-			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\", \"$arg\")\n")
-			    if $debug;
-			&{$linkage{$opt}}($opt, $arg);
-		    }
-		    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 ( $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 ( $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 {
-		    print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
-		    $userlinkage->{$opt} = $arg;
-		}
-	    }
-	}
+    -foo -- arg1 -bar arg2 arg3
 
-	# 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{'<>'})) ) {
-		&$cb($tryopt);
-	    }
-	    else {
-		print STDERR ("=> saving \"$tryopt\" ",
-			      "(not an option, may permute)\n") if $debug;
-		push (@ret, $tryopt);
-	    }
-	    next;
-	}
+=item bundling (default: reset)
 
-	# ...otherwise, terminate.
-	else {
-	    # Push this one back and exit.
-	    unshift (@ARGV, $tryopt);
-	    return ($error == 0);
-	}
+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 B<--> and single-character
+options (and bundles) with B<->. For example,
 
-    }
+    ps -vax --vax
 
-    # Finish.
-    if ( $order == $PERMUTE ) {
-	#  Push back accumulated arguments
-	print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
-	    if $debug && @ret > 0;
-	unshift (@ARGV, @ret) if @ret > 0;
-    }
+would be equivalent to
 
-    return ($error == 0);
-}
+    ps -v -a -x --vax
 
-sub config (@) {
-    my (@options) = @_;
-    my $opt;
-    foreach $opt ( @options ) {
-	my $try = lc ($opt);
-	my $action = 1;
-	if ( $try =~ /^no_?/ ) {
-	    $action = 0;
-	    $try = $';
-	}
-	if ( $try eq 'default' or $try eq 'defaults' ) {
-	    &$config_defaults () if $action;
-	}
-	elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
-	    $autoabbrev = $action;
-	}
-	elsif ( $try eq 'getopt_compat' ) {
-	    $getopt_compat = $action;
-	}
-	elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
-	    $ignorecase = $action;
-	}
-	elsif ( $try eq 'ignore_case_always' ) {
-	    $ignorecase = $action ? 2 : 0;
-	}
-	elsif ( $try eq 'bundling' ) {
-	    $bundling = $action;
-	}
-	elsif ( $try eq 'bundling_override' ) {
-	    $bundling = $action ? 2 : 0;
-	}
-	elsif ( $try eq 'require_order' ) {
-	    $order = $action ? $REQUIRE_ORDER : $PERMUTE;
-	}
-	elsif ( $try eq 'permute' ) {
-	    $order = $action ? $PERMUTE : $REQUIRE_ORDER;
-	}
-	elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
-	    $passthrough = $action;
-	}
-	elsif ( $try eq 'debug' ) {
-	    $debug = $action;
-	}
-	else {
-	    $Carp::CarpLevel = 1;
-	    Carp::croak("Getopt::Long: unknown config parameter \"$opt\"")
-	}
-    }
-}
+provided "vax", "v", "a" and "x" have been defined to be valid
+options. 
+
+Bundled options can also include a value in the bundle; for strings
+this value is the rest of the bundle, but integer and floating values
+may be combined in the bundle, e.g.
+
+    scale -h24w80
+
+is equivalent to
 
-# Modified from Exporter. This one handles 2.001 and 2.01 etc just like 2.1.
-sub require_version {
-    no strict;
-    my ($self, $wanted) = @_;
-    my $pkg = ref $self || $self;
-    my $version = $ {"${pkg}::VERSION"} || "(undef)";
-
-    $wanted .= '.0' unless $wanted =~ /\./;
-    $wanted = $1 * 1000 + $2 if $wanted =~ /^(\d+)\.(\d+)$/;
-    $version = $1 * 1000 + $2 if $version =~ /^(\d+)\.(\d+)$/;
-    if ( $version < $wanted ) {
-	$version =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
-	$wanted =~ s/^(\d+)(\d\d\d)$/$1.'.'.(0+$2)/e;
-	$Carp::CarpLevel = 1;
-	Carp::croak("$pkg $wanted required--this is only version $version")
-    }
-    $version;
-}
+    scale -h 24 -w 80
 
-################ Private Subroutines ################
+Note: resetting B<bundling> also resets B<bundling_override>.
 
-$find_option = sub {
+=item bundling_override (default: reset)
 
-    return 0 unless $opt =~ /^$genprefix/;
+If B<bundling_override> is set, bundling is enabled as with
+B<bundling> but now long option names override option bundles. In the
+above example, B<-vax> would be interpreted as the option "vax", not
+the bundle "v", "a", "x".
 
-    $opt = $';
-    my ($starter) = $&;
+Note: resetting B<bundling_override> also resets B<bundling>.
 
-    my $optarg = undef;	# value supplied with --opt=value
-    my $rest = undef;	# remainder from unbundling
+B<Note:> Using option bundling can easily lead to unexpected results,
+especially when mixing long options and bundles. Caveat emptor.
 
-    # If it is a long option, it may include the value.
-    if (($starter eq "--" || $getopt_compat)
-	&& $opt =~ /^([^=]+)=/ ) {
-	$opt = $1;
-	$optarg = $';
-	print STDERR ("=> option \"", $opt, 
-		      "\", optarg = \"$optarg\"\n") if $debug;
-    }
+=item ignore_case  (default: set)
 
-    #### Look it up ###
+If set, case is ignored when matching options.
 
-    my $tryopt = $opt;		# option to try
-    my $optbl = \%opctl;	# table to look it up (long names)
-    my $type;
+Note: resetting B<ignore_case> also resets B<ignore_case_always>.
 
-    if ( $bundling && $starter eq '-' ) {
-	# Unbundle single letter option.
-	$rest = 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 '';
-	$optbl = \%bopctl;	# look it up in the short names table
+=item ignore_case_always (default: reset)
 
-	# If bundling == 2, long options can override bundles.
-	if ( $bundling == 2 and
-	     defined ($type = $opctl{$tryopt.$rest}) ) {
-	    print STDERR ("=> $starter$tryopt rebundled to ",
-			  "$starter$tryopt$rest\n") if $debug;
-	    $tryopt .= $rest;
-	    undef $rest;
-	}
-    } 
+When bundling is in effect, case is ignored on single-character
+options also. 
 
-    # Try auto-abbreviation.
-    elsif ( $autoabbrev ) {
-	# Downcase if allowed.
-	$tryopt = $opt = lc ($opt) if $ignorecase;
-	# Turn option name into pattern.
-	my $pat = quotemeta ($opt);
-	# Look up in option names.
-	my @hits = grep (/^$pat/, @opctl);
-	print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
-		      "out of ", scalar(@opctl), "\n") if $debug;
+Note: resetting B<ignore_case_always> also resets B<ignore_case>.
 
-	# Check for ambiguous results.
-	unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
-	    # See if all matches are for the same option.
-	    my %hit;
-	    foreach ( @hits ) {
-		$_ = $aliases{$_} if defined $aliases{$_};
-		$hit{$_} = 1;
-	    }
-	    # Now see if it really is ambiguous.
-	    unless ( keys(%hit) == 1 ) {
-		return 0 if $passthrough;
-		print STDERR ("Option ", $opt, " is ambiguous (",
-			      join(", ", @hits), ")\n");
-		$error++;
-		undef $opt;
-		return 1;
-	    }
-	    @hits = keys(%hit);
-	}
+=item pass_through (default: reset)
 
-	# 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;
-	}
-    }
+Unknown options are passed through in @ARGV instead of being flagged
+as errors. This makes it possible to write wrapper scripts that
+process only part of the user supplied options, and passes the
+remaining options to some other program.
 
-    # Map to all lowercase if ignoring case.
-    elsif ( $ignorecase ) {
-	$tryopt = lc ($opt);
-    }
+This can be very confusing, especially when B<permute> is also set.
 
-    # Check validity by fetching the info.
-    $type = $optbl->{$tryopt} unless defined $type;
-    unless  ( defined $type ) {
-	return 0 if $passthrough;
-	warn ("Unknown option: ", $opt, "\n");
-	$error++;
-	return 1;
-    }
-    # Apparently valid.
-    $opt = $tryopt;
-    print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
+=item debug (default: reset)
 
-    #### Determine argument status ####
+Enable copious debugging output.
 
-    # If it is an option w/o argument, we're almost finished with it.
-    if ( $type eq '' || $type eq '!' ) {
-	if ( defined $optarg ) {
-	    return 0 if $passthrough;
-	    print STDERR ("Option ", $opt, " does not take an argument\n");
-	    $error++;
-	    undef $opt;
-	}
-	elsif ( $type eq '' ) {
-	    $arg = 1;		# supply explicit value
-	}
-	else {
-	    substr ($opt, 0, 2) = ''; # strip NO prefix
-	    $arg = 0;		# supply explicit value
-	}
-	unshift (@ARGV, $starter.$rest) if defined $rest;
-	return 1;
-    }
+=back
 
-    # Get mandatory status and type info.
-    my $mand;
-    ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/;
+=head1 OTHER USEFUL VARIABLES
 
-    # Check if there is an option argument available.
-    if ( defined $optarg ? ($optarg eq '') 
-	 : !(defined $rest || @ARGV > 0) ) {
-	# Complain if this option needs an argument.
-	if ( $mand eq "=" ) {
-	    return 0 if $passthrough;
-	    print STDERR ("Option ", $opt, " requires an argument\n");
-	    $error++;
-	    undef $opt;
-	}
-	if ( $mand eq ":" ) {
-	    $arg = $type eq "s" ? '' : 0;
-	}
-	return 1;
-    }
+=over 12
 
-    # Get (possibly optional) argument.
-    $arg = (defined $rest ? $rest
-	    : (defined $optarg ? $optarg : shift (@ARGV)));
+=item $Getopt::Long::VERSION
 
-    # Get key if this is a "name=value" pair for a hash option.
-    $key = undef;
-    if ($hash && defined $arg) {
-	($key, $arg) = ($arg =~ /=/o) ? ($`, $') : ($arg, 1);
-    }
+The version number of this Getopt::Long implementation in the format
+C<major>.C<minor>. This can be used to have Exporter check the
+version, e.g.
 
-    #### Check if the argument is valid for this option ####
+    use Getopt::Long 3.00;
 
-    if ( $type eq "s" ) {	# string
-	# A mandatory string takes anything. 
-	return 1 if $mand eq "=";
+You can inspect $Getopt::Long::major_version and
+$Getopt::Long::minor_version for the individual components.
 
-	# An optional string takes almost anything. 
-	return 1 if defined $optarg || defined $rest;
-	return 1 if $arg eq "-"; # ??
+=item $Getopt::Long::error
 
-	# Check for option or option list terminator.
-	if ($arg eq $argend ||
-	    $arg =~ /^$genprefix.+/) {
-	    # Push back.
-	    unshift (@ARGV, $arg);
-	    # Supply empty value.
-	    $arg = '';
-	}
-    }
+Internal error flag. May be incremented from a call-back routine to
+cause options parsing to fail.
 
-    elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
-	if ( $arg !~ /^-?[0-9]+$/ ) {
-	    if ( defined $optarg || $mand eq "=" ) {
-		if ( $passthrough ) {
-		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
-		      unless defined $optarg;
-		    return 0;
-		}
-		print STDERR ("Value \"", $arg, "\" invalid for option ",
-			      $opt, " (number expected)\n");
-		$error++;
-		undef $opt;
-		# Push back.
-		unshift (@ARGV, $starter.$rest) if defined $rest;
-	    }
-	    else {
-		# Push back.
-		unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
-		# Supply default value.
-		$arg = 0;
-	    }
-	}
-    }
+=back
 
-    elsif ( $type eq "f" ) { # real number, int is also ok
-	if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) {
-	    if ( defined $optarg || $mand eq "=" ) {
-		if ( $passthrough ) {
-		    unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
-		      unless defined $optarg;
-		    return 0;
-		}
-		print STDERR ("Value \"", $arg, "\" invalid for option ",
-			      $opt, " (real number expected)\n");
-		$error++;
-		undef $opt;
-		# Push back.
-		unshift (@ARGV, $starter.$rest) if defined $rest;
-	    }
-	    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;
-};
+=head1 AUTHOR
 
-$config_defaults = sub {
-    # Handle POSIX compliancy.
-    if ( defined $ENV{"POSIXLY_CORRECT"} ) {
-	$gen_prefix = "(--|-)";
-	$autoabbrev = 0;		# no automatic abbrev of options
-	$bundling = 0;			# no bundling of single letter switches
-	$getopt_compat = 0;		# disallow '+' to start options
-	$order = $REQUIRE_ORDER;
-    }
-    else {
-	$gen_prefix = "(--|-|\\+)";
-	$autoabbrev = 1;		# automatic abbrev of options
-	$bundling = 0;			# bundling off by default
-	$getopt_compat = 1;		# allow '+' to start options
-	$order = $PERMUTE;
-    }
-    # Other configurable settings.
-    $debug = 0;			# for debugging
-    $error = 0;			# error tally
-    $ignorecase = 1;		# ignore case when matching options
-    $passthrough = 0;		# leave unrecognized options alone
-};
+Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
 
-################ Initialization ################
+=head1 COPYRIGHT AND DISCLAIMER
 
-# 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+)/;
+This program is Copyright 1990,1997 by Johan Vromans.
+This program is free software; you can redistribute it and/or
+modify it under the terms of 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.
 
-# Set defaults.
-&$config_defaults ();
+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.
 
-################ Package return ################
+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.
 
-1;
+=cut