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