lib/Getopt/Long.pm

   1 # GetOpt::Long.pm -- Universal options parsing
   2
   3 package Getopt::Long;
   4
   5 # RCS Status      : $Id: GetoptLong.pl,v 2.18 1998-06-14 15:02:19+02 jv Exp $
   6 # Author          : Johan Vromans
   7 # Created On      : Tue Sep 11 15:00:12 1990
   8 # Last Modified By: Johan Vromans
   9 # Last Modified On: Sun Jun 14 13:17:22 1998
  10 # Update Count    : 705
  11 # Status          : Released
  12
  13 ################ Copyright ################
  14
  15 # This program is Copyright 1990,1998 by Johan Vromans.
  16 # This program is free software; you can redistribute it and/or
  17 # modify it under the terms of the GNU General Public License
  18 # as published by the Free Software Foundation; either version 2
  19 # of the License, or (at your option) any later version.
  20 #
  21 # This program is distributed in the hope that it will be useful,
  22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 # GNU General Public License for more details.
  25 #
  26 # If you do not have a copy of the GNU General Public License write to
  27 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
  28 # MA 02139, USA.
  29
  30 ################ Module Preamble ################
  31
  32 use strict;
  33
  34 BEGIN {
  35     require 5.004;
  36     use Exporter ();
  37     use vars     qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38     $VERSION     = "2.17";
  39
  40     @ISA         = qw(Exporter);
  41     @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
  42     %EXPORT_TAGS = qw();
  43     @EXPORT_OK   = qw();
  44     use AutoLoader qw(AUTOLOAD);
  45 }
  46
  47 # User visible variables.
  48 use vars @EXPORT, @EXPORT_OK;
  49 use vars qw($error $debug $major_version $minor_version);
  50 # Deprecated visible variables.
  51 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  52             $passthrough);
  53 # Official invisible variables.
  54 use vars qw($genprefix);
  55
  56 # Public subroutines.
  57 sub Configure (@);
  58 sub config (@);                 # deprecated name
  59 sub GetOptions;
  60
  61 # Private subroutines.
  62 sub ConfigDefaults ();
  63 sub FindOption ($$$$$$$);
  64 sub Croak (@);                  # demand loading the real Croak
  65
  66 ################ Local Variables ################
  67
  68 ################ Resident subroutines ################
  69
  70 sub ConfigDefaults () {
  71     # Handle POSIX compliancy.
  72     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  73         $genprefix = "(--|-)";
  74         $autoabbrev = 0;                # no automatic abbrev of options
  75         $bundling = 0;                  # no bundling of single letter switches
  76         $getopt_compat = 0;             # disallow '+' to start options
  77         $order = $REQUIRE_ORDER;
  78     }
  79     else {
  80         $genprefix = "(--|-|\\+)";
  81         $autoabbrev = 1;                # automatic abbrev of options
  82         $bundling = 0;                  # bundling off by default
  83         $getopt_compat = 1;             # allow '+' to start options
  84         $order = $PERMUTE;
  85     }
  86     # Other configurable settings.
  87     $debug = 0;                 # for debugging
  88     $error = 0;                 # error tally
  89     $ignorecase = 1;            # ignore case when matching options
  90     $passthrough = 0;           # leave unrecognized options alone
  91 }
  92
  93 ################ Initialization ################
  94
  95 # Values for $order. See GNU getopt.c for details.
  96 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
  97 # Version major/minor numbers.
  98 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
  99
 100 # Set defaults.
 101 ConfigDefaults ();
 102
 103 ################ Package return ################
 104
 105 1;
 106
 107 __END__
 108
 109 ################ AutoLoading subroutines ################
 110
 111 # RCS Status      : $Id: GetoptLongAl.pl,v 2.20 1998-06-14 15:02:19+02 jv Exp $
 112 # Author          : Johan Vromans
 113 # Created On      : Fri Mar 27 11:50:30 1998
 114 # Last Modified By: Johan Vromans
 115 # Last Modified On: Sun Jun 14 13:54:35 1998
 116 # Update Count    : 24
 117 # Status          : Released
 118
 119 sub GetOptions {
 120
 121     my @optionlist = @_;        # local copy of the option descriptions
 122     my $argend = '--';          # option list terminator
 123     my %opctl = ();             # table of arg.specs (long and abbrevs)
 124     my %bopctl = ();            # table of arg.specs (bundles)
 125     my $pkg = (caller)[0];      # current context
 126                                 # Needed if linkage is omitted.
 127     my %aliases= ();            # alias table
 128     my @ret = ();               # accum for non-options
 129     my %linkage;                # linkage
 130     my $userlinkage;            # user supplied HASH
 131     my $opt;                    # current option
 132     my $genprefix = $genprefix; # so we can call the same module many times
 133     my @opctl;                  # the possible long option names
 134
 135     $error = '';
 136
 137     print STDERR ("GetOpt::Long $Getopt::Long::VERSION ",
 138                   "called from package \"$pkg\".",
 139                   "\n  ",
 140                   'GetOptionsAl $Revision: 2.20 $ ',
 141                   "\n  ",
 142                   "ARGV: (@ARGV)",
 143                   "\n  ",
 144                   "autoabbrev=$autoabbrev,".
 145                   "bundling=$bundling,",
 146                   "getopt_compat=$getopt_compat,",
 147                   "order=$order,",
 148                   "\n  ",
 149                   "ignorecase=$ignorecase,",
 150                   "passthrough=$passthrough,",
 151                   "genprefix=\"$genprefix\".",
 152                   "\n")
 153         if $debug;
 154
 155     # Check for ref HASH as first argument.
 156     # First argument may be an object. It's OK to use this as long
 157     # as it is really a hash underneath.
 158     $userlinkage = undef;
 159     if ( ref($optionlist[0]) and
 160          "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
 161         $userlinkage = shift (@optionlist);
 162         print STDERR ("=> user linkage: $userlinkage\n") if $debug;
 163     }
 164
 165     # See if the first element of the optionlist contains option
 166     # starter characters.
 167     if ( $optionlist[0] =~ /^\W+$/ ) {
 168         $genprefix = shift (@optionlist);
 169         # Turn into regexp. Needs to be parenthesized!
 170         $genprefix =~ s/(\W)/\\$1/g;
 171         $genprefix = "([" . $genprefix . "])";
 172     }
 173
 174     # Verify correctness of optionlist.
 175     %opctl = ();
 176     %bopctl = ();
 177     while ( @optionlist > 0 ) {
 178         my $opt = shift (@optionlist);
 179
 180         # Strip leading prefix so people can specify "--foo=i" if they like.
 181         $opt = $+ if $opt =~ /^$genprefix+(.*)$/s;
 182
 183         if ( $opt eq '<>' ) {
 184             if ( (defined $userlinkage)
 185                 && !(@optionlist > 0 && ref($optionlist[0]))
 186                 && (exists $userlinkage->{$opt})
 187                 && ref($userlinkage->{$opt}) ) {
 188                 unshift (@optionlist, $userlinkage->{$opt});
 189             }
 190             unless ( @optionlist > 0
 191                     && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
 192                 $error .= "Option spec <> requires a reference to a subroutine\n";
 193                 next;
 194             }
 195             $linkage{'<>'} = shift (@optionlist);
 196             next;
 197         }
 198
 199         # Match option spec. Allow '?' as an alias.
 200         if ( $opt !~ /^((\w+[-\w]*)(\|(\?|\w[-\w]*)?)*)?([!~+]|[=:][infse][@%]?)?$/ ) {
 201             $error .= "Error in option spec: \"$opt\"\n";
 202             next;
 203         }
 204         my ($o, $c, $a) = ($1, $5);
 205         $c = '' unless defined $c;
 206
 207         if ( ! defined $o ) {
 208             # empty -> '-' option
 209             $opctl{$o = ''} = $c;
 210         }
 211         else {
 212             # Handle alias names
 213             my @o =  split (/\|/, $o);
 214             my $linko = $o = $o[0];
 215             # Force an alias if the option name is not locase.
 216             $a = $o unless $o eq lc($o);
 217             $o = lc ($o)
 218                 if $ignorecase > 1
 219                     || ($ignorecase
 220                         && ($bundling ? length($o) > 1  : 1));
 221
 222             foreach ( @o ) {
 223                 if ( $bundling && length($_) == 1 ) {
 224                     $_ = lc ($_) if $ignorecase > 1;
 225                     if ( $c eq '!' ) {
 226                         $opctl{"no$_"} = $c;
 227                         warn ("Ignoring '!' modifier for short option $_\n");
 228                         $c = '';
 229                     }
 230                     $opctl{$_} = $bopctl{$_} = $c;
 231                 }
 232                 else {
 233                     $_ = lc ($_) if $ignorecase;
 234                     if ( $c eq '!' ) {
 235                         $opctl{"no$_"} = $c;
 236                         $c = '';
 237                     }
 238                     $opctl{$_} = $c;
 239                 }
 240                 if ( defined $a ) {
 241                     # Note alias.
 242                     $aliases{$_} = $a;
 243                 }
 244                 else {
 245                     # Set primary name.
 246                     $a = $_;
 247                 }
 248             }
 249             $o = $linko;
 250         }
 251
 252         # If no linkage is supplied in the @optionlist, copy it from
 253         # the userlinkage if available.
 254         if ( defined $userlinkage ) {
 255             unless ( @optionlist > 0 && ref($optionlist[0]) ) {
 256                 if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) {
 257                     print STDERR ("=> found userlinkage for \"$o\": ",
 258                                   "$userlinkage->{$o}\n")
 259                         if $debug;
 260                     unshift (@optionlist, $userlinkage->{$o});
 261                 }
 262                 else {
 263                     # Do nothing. Being undefined will be handled later.
 264                     next;
 265                 }
 266             }
 267         }
 268
 269         # Copy the linkage. If omitted, link to global variable.
 270         if ( @optionlist > 0 && ref($optionlist[0]) ) {
 271             print STDERR ("=> link \"$o\" to $optionlist[0]\n")
 272                 if $debug;
 273             if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) {
 274                 $linkage{$o} = shift (@optionlist);
 275             }
 276             elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) {
 277                 $linkage{$o} = shift (@optionlist);
 278                 $opctl{$o} .= '@'
 279                   if $opctl{$o} ne '' and $opctl{$o} !~ /\@$/;
 280                 $bopctl{$o} .= '@'
 281                   if $bundling and defined $bopctl{$o} and
 282                     $bopctl{$o} ne '' and $bopctl{$o} !~ /\@$/;
 283             }
 284             elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) {
 285                 $linkage{$o} = shift (@optionlist);
 286                 $opctl{$o} .= '%'
 287                   if $opctl{$o} ne '' and $opctl{$o} !~ /\%$/;
 288                 $bopctl{$o} .= '%'
 289                   if $bundling and defined $bopctl{$o} and
 290                     $bopctl{$o} ne '' and $bopctl{$o} !~ /\%$/;
 291             }
 292             else {
 293                 $error .= "Invalid option linkage for \"$opt\"\n";
 294             }
 295         }
 296         else {
 297             # Link to global $opt_XXX variable.
 298             # Make sure a valid perl identifier results.
 299             my $ov = $o;
 300             $ov =~ s/\W/_/g;
 301             if ( $c =~ /@/ ) {
 302                 print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n")
 303                     if $debug;
 304                 eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;");
 305             }
 306             elsif ( $c =~ /%/ ) {
 307                 print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n")
 308                     if $debug;
 309                 eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;");
 310             }
 311             else {
 312                 print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n")
 313                     if $debug;
 314                 eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;");
 315             }
 316         }
 317     }
 318
 319     # Bail out if errors found.
 320     die ($error) if $error;
 321     $error = 0;
 322
 323     # Sort the possible long option names.
 324     @opctl = sort(keys (%opctl)) if $autoabbrev;
 325
 326     # Show the options tables if debugging.
 327     if ( $debug ) {
 328         my ($arrow, $k, $v);
 329         $arrow = "=> ";
 330         while ( ($k,$v) = each(%opctl) ) {
 331             print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n");
 332             $arrow = "   ";
 333         }
 334         $arrow = "=> ";
 335         while ( ($k,$v) = each(%bopctl) ) {
 336             print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n");
 337             $arrow = "   ";
 338         }
 339     }
 340
 341     # Process argument list
 342     while ( @ARGV > 0 ) {
 343
 344         #### Get next argument ####
 345
 346         $opt = shift (@ARGV);
 347         print STDERR ("=> option \"", $opt, "\"\n") if $debug;
 348
 349         #### Determine what we have ####
 350
 351         # Double dash is option list terminator.
 352         if ( $opt eq $argend ) {
 353             # Finish. Push back accumulated arguments and return.
 354             unshift (@ARGV, @ret)
 355                 if $order == $PERMUTE;
 356             return ($error == 0);
 357         }
 358
 359         my $tryopt = $opt;
 360         my $found;              # success status
 361         my $dsttype;            # destination type ('@' or '%')
 362         my $incr;               # destination increment
 363         my $key;                # key (if hash type)
 364         my $arg;                # option argument
 365
 366         ($found, $opt, $arg, $dsttype, $incr, $key) =
 367           FindOption ($genprefix, $argend, $opt,
 368                       \%opctl, \%bopctl, \@opctl, \%aliases);
 369
 370         if ( $found ) {
 371
 372             # FindOption undefines $opt in case of errors.
 373             next unless defined $opt;
 374
 375             if ( defined $arg ) {
 376                 $opt = $aliases{$opt} if defined $aliases{$opt};
 377
 378                 if ( defined $linkage{$opt} ) {
 379                     print STDERR ("=> ref(\$L{$opt}) -> ",
 380                                   ref($linkage{$opt}), "\n") if $debug;
 381
 382                     if ( ref($linkage{$opt}) eq 'SCALAR' ) {
 383                         if ( $incr ) {
 384                             print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
 385                               if $debug;
 386                             if ( defined ${$linkage{$opt}} ) {
 387                                 ${$linkage{$opt}} += $arg;
 388                             }
 389                             else {
 390                                 ${$linkage{$opt}} = $arg;
 391                             }
 392                         }
 393                         else {
 394                             print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
 395                               if $debug;
 396                             ${$linkage{$opt}} = $arg;
 397                         }
 398                     }
 399                     elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
 400                         print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
 401                             if $debug;
 402                         push (@{$linkage{$opt}}, $arg);
 403                     }
 404                     elsif ( ref($linkage{$opt}) eq 'HASH' ) {
 405                         print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
 406                             if $debug;
 407                         $linkage{$opt}->{$key} = $arg;
 408                     }
 409                     elsif ( ref($linkage{$opt}) eq 'CODE' ) {
 410                         print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n")
 411                             if $debug;
 412                         &{$linkage{$opt}}($opt, $arg);
 413                     }
 414                     else {
 415                         print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
 416                                       "\" in linkage\n");
 417                         Croak ("Getopt::Long -- internal error!\n");
 418                     }
 419                 }
 420                 # No entry in linkage means entry in userlinkage.
 421                 elsif ( $dsttype eq '@' ) {
 422                     if ( defined $userlinkage->{$opt} ) {
 423                         print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
 424                             if $debug;
 425                         push (@{$userlinkage->{$opt}}, $arg);
 426                     }
 427                     else {
 428                         print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
 429                             if $debug;
 430                         $userlinkage->{$opt} = [$arg];
 431                     }
 432                 }
 433                 elsif ( $dsttype eq '%' ) {
 434                     if ( defined $userlinkage->{$opt} ) {
 435                         print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
 436                             if $debug;
 437                         $userlinkage->{$opt}->{$key} = $arg;
 438                     }
 439                     else {
 440                         print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
 441                             if $debug;
 442                         $userlinkage->{$opt} = {$key => $arg};
 443                     }
 444                 }
 445                 else {
 446                     if ( $incr ) {
 447                         print STDERR ("=> \$L{$opt} += \"$arg\"\n")
 448                           if $debug;
 449                         if ( defined $userlinkage->{$opt} ) {
 450                             $userlinkage->{$opt} += $arg;
 451                         }
 452                         else {
 453                             $userlinkage->{$opt} = $arg;
 454                         }
 455                     }
 456                     else {
 457                         print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
 458                         $userlinkage->{$opt} = $arg;
 459                     }
 460                 }
 461             }
 462         }
 463
 464         # Not an option. Save it if we $PERMUTE and don't have a <>.
 465         elsif ( $order == $PERMUTE ) {
 466             # Try non-options call-back.
 467             my $cb;
 468             if ( (defined ($cb = $linkage{'<>'})) ) {
 469                 &$cb ($tryopt);
 470             }
 471             else {
 472                 print STDERR ("=> saving \"$tryopt\" ",
 473                               "(not an option, may permute)\n") if $debug;
 474                 push (@ret, $tryopt);
 475             }
 476             next;
 477         }
 478
 479         # ...otherwise, terminate.
 480         else {
 481             # Push this one back and exit.
 482             unshift (@ARGV, $tryopt);
 483             return ($error == 0);
 484         }
 485
 486     }
 487
 488     # Finish.
 489     if ( $order == $PERMUTE ) {
 490         #  Push back accumulated arguments
 491         print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
 492             if $debug && @ret > 0;
 493         unshift (@ARGV, @ret) if @ret > 0;
 494     }
 495
 496     return ($error == 0);
 497 }
 498
 499 # Option lookup.
 500 sub FindOption ($$$$$$$) {
 501
 502     # returns (1, $opt, $arg, $dsttype, $incr, $key) if okay,
 503     # returns (0) otherwise.
 504
 505     my ($prefix, $argend, $opt, $opctl, $bopctl, $names, $aliases) = @_;
 506     my $key;                    # hash key for a hash option
 507     my $arg;
 508
 509     print STDERR ("=> find \"$opt\", prefix=\"$prefix\"\n") if $debug;
 510
 511     return (0) unless $opt =~ /^$prefix(.*)$/s;
 512
 513     $opt = $+;
 514     my ($starter) = $1;
 515
 516     print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
 517
 518     my $optarg = undef; # value supplied with --opt=value
 519     my $rest = undef;   # remainder from unbundling
 520
 521     # If it is a long option, it may include the value.
 522     if (($starter eq "--" || ($getopt_compat && !$bundling))
 523         && $opt =~ /^([^=]+)=(.*)$/s ) {
 524         $opt = $1;
 525         $optarg = $2;
 526         print STDERR ("=> option \"", $opt,
 527                       "\", optarg = \"$optarg\"\n") if $debug;
 528     }
 529
 530     #### Look it up ###
 531
 532     my $tryopt = $opt;          # option to try
 533     my $optbl = $opctl;         # table to look it up (long names)
 534     my $type;
 535     my $dsttype = '';
 536     my $incr = 0;
 537
 538     if ( $bundling && $starter eq '-' ) {
 539         # Unbundle single letter option.
 540         $rest = substr ($tryopt, 1);
 541         $tryopt = substr ($tryopt, 0, 1);
 542         $tryopt = lc ($tryopt) if $ignorecase > 1;
 543         print STDERR ("=> $starter$tryopt unbundled from ",
 544                       "$starter$tryopt$rest\n") if $debug;
 545         $rest = undef unless $rest ne '';
 546         $optbl = $bopctl;       # look it up in the short names table
 547
 548         # If bundling == 2, long options can override bundles.
 549         if ( $bundling == 2 and
 550              defined ($type = $opctl->{$tryopt.$rest}) ) {
 551             print STDERR ("=> $starter$tryopt rebundled to ",
 552                           "$starter$tryopt$rest\n") if $debug;
 553             $tryopt .= $rest;
 554             undef $rest;
 555         }
 556     }
 557
 558     # Try auto-abbreviation.
 559     elsif ( $autoabbrev ) {
 560         # Downcase if allowed.
 561         $tryopt = $opt = lc ($opt) if $ignorecase;
 562         # Turn option name into pattern.
 563         my $pat = quotemeta ($opt);
 564         # Look up in option names.
 565         my @hits = grep (/^$pat/, @{$names});
 566         print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
 567                       "out of ", scalar(@{$names}), "\n") if $debug;
 568
 569         # Check for ambiguous results.
 570         unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
 571             # See if all matches are for the same option.
 572             my %hit;
 573             foreach ( @hits ) {
 574                 $_ = $aliases->{$_} if defined $aliases->{$_};
 575                 $hit{$_} = 1;
 576             }
 577             # Now see if it really is ambiguous.
 578             unless ( keys(%hit) == 1 ) {
 579                 return (0) if $passthrough;
 580                 warn ("Option ", $opt, " is ambiguous (",
 581                       join(", ", @hits), ")\n");
 582                 $error++;
 583                 undef $opt;
 584                 return (1, $opt,$arg,$dsttype,$incr,$key);
 585             }
 586             @hits = keys(%hit);
 587         }
 588
 589         # Complete the option name, if appropriate.
 590         if ( @hits == 1 && $hits[0] ne $opt ) {
 591             $tryopt = $hits[0];
 592             $tryopt = lc ($tryopt) if $ignorecase;
 593             print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
 594                 if $debug;
 595         }
 596     }
 597
 598     # Map to all lowercase if ignoring case.
 599     elsif ( $ignorecase ) {
 600         $tryopt = lc ($opt);
 601     }
 602
 603     # Check validity by fetching the info.
 604     $type = $optbl->{$tryopt} unless defined $type;
 605     unless  ( defined $type ) {
 606         return (0) if $passthrough;
 607         warn ("Unknown option: ", $opt, "\n");
 608         $error++;
 609         return (1, $opt,$arg,$dsttype,$incr,$key);
 610     }
 611     # Apparently valid.
 612     $opt = $tryopt;
 613     print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug;
 614
 615     #### Determine argument status ####
 616
 617     # If it is an option w/o argument, we're almost finished with it.
 618     if ( $type eq '' || $type eq '!' || $type eq '+' ) {
 619         if ( defined $optarg ) {
 620             return (0) if $passthrough;
 621             warn ("Option ", $opt, " does not take an argument\n");
 622             $error++;
 623             undef $opt;
 624         }
 625         elsif ( $type eq '' || $type eq '+' ) {
 626             $arg = 1;           # supply explicit value
 627             $incr = $type eq '+';
 628         }
 629         else {
 630             substr ($opt, 0, 2) = ''; # strip NO prefix
 631             $arg = 0;           # supply explicit value
 632         }
 633         unshift (@ARGV, $starter.$rest) if defined $rest;
 634         return (1, $opt,$arg,$dsttype,$incr,$key);
 635     }
 636
 637     # Get mandatory status and type info.
 638     my $mand;
 639     ($mand, $type, $dsttype, $key) = $type =~ /^(.)(.)([@%]?)$/;
 640
 641     # Check if there is an option argument available.
 642     if ( defined $optarg ? ($optarg eq '')
 643          : !(defined $rest || @ARGV > 0) ) {
 644         # Complain if this option needs an argument.
 645         if ( $mand eq "=" ) {
 646             return (0) if $passthrough;
 647             warn ("Option ", $opt, " requires an argument\n");
 648             $error++;
 649             undef $opt;
 650         }
 651         if ( $mand eq ":" ) {
 652             $arg = $type eq "s" ? '' : 0;
 653         }
 654         return (1, $opt,$arg,$dsttype,$incr,$key);
 655     }
 656
 657     # Get (possibly optional) argument.
 658     $arg = (defined $rest ? $rest
 659             : (defined $optarg ? $optarg : shift (@ARGV)));
 660
 661     # Get key if this is a "name=value" pair for a hash option.
 662     $key = undef;
 663     if ($dsttype eq '%' && defined $arg) {
 664         ($key, $arg) = ($arg =~ /^(.*)=(.*)$/s) ? ($1, $2) : ($arg, 1);
 665     }
 666
 667     #### Check if the argument is valid for this option ####
 668
 669     if ( $type eq "s" ) {       # string
 670         # A mandatory string takes anything.
 671         return (1, $opt,$arg,$dsttype,$incr,$key) if $mand eq "=";
 672
 673         # An optional string takes almost anything.
 674         return (1, $opt,$arg,$dsttype,$incr,$key)
 675           if defined $optarg || defined $rest;
 676         return (1, $opt,$arg,$dsttype,$incr,$key) if $arg eq "-"; # ??
 677
 678         # Check for option or option list terminator.
 679         if ($arg eq $argend ||
 680             $arg =~ /^$prefix.+/) {
 681             # Push back.
 682             unshift (@ARGV, $arg);
 683             # Supply empty value.
 684             $arg = '';
 685         }
 686     }
 687
 688     elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer
 689         if ( $bundling && defined $rest && $rest =~ /^(-?[0-9]+)(.*)$/s ) {
 690             $arg = $1;
 691             $rest = $2;
 692             unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 693         }
 694         elsif ( $arg !~ /^-?[0-9]+$/ ) {
 695             if ( defined $optarg || $mand eq "=" ) {
 696                 if ( $passthrough ) {
 697                     unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 698                       unless defined $optarg;
 699                     return (0);
 700                 }
 701                 warn ("Value \"", $arg, "\" invalid for option ",
 702                       $opt, " (number expected)\n");
 703                 $error++;
 704                 undef $opt;
 705                 # Push back.
 706                 unshift (@ARGV, $starter.$rest) if defined $rest;
 707             }
 708             else {
 709                 # Push back.
 710                 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
 711                 # Supply default value.
 712                 $arg = 0;
 713             }
 714         }
 715     }
 716
 717     elsif ( $type eq "f" ) { # real number, int is also ok
 718         # We require at least one digit before a point or 'e',
 719         # and at least one digit following the point and 'e'.
 720         # [-]NN[.NN][eNN]
 721         if ( $bundling && defined $rest &&
 722              $rest =~ /^(-?[0-9]+(\.[0-9]+)?([eE]-?[0-9]+)?)(.*)$/s ) {
 723             $arg = $1;
 724             $rest = $+;
 725             unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 726         }
 727         elsif ( $arg !~ /^-?[0-9.]+(\.[0-9]+)?([eE]-?[0-9]+)?$/ ) {
 728             if ( defined $optarg || $mand eq "=" ) {
 729                 if ( $passthrough ) {
 730                     unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 731                       unless defined $optarg;
 732                     return (0);
 733                 }
 734                 warn ("Value \"", $arg, "\" invalid for option ",
 735                       $opt, " (real number expected)\n");
 736                 $error++;
 737                 undef $opt;
 738                 # Push back.
 739                 unshift (@ARGV, $starter.$rest) if defined $rest;
 740             }
 741             else {
 742                 # Push back.
 743                 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
 744                 # Supply default value.
 745                 $arg = 0.0;
 746             }
 747         }
 748     }
 749     else {
 750         Croak ("GetOpt::Long internal error (Can't happen)\n");
 751     }
 752     return (1, $opt, $arg, $dsttype, $incr, $key);
 753 }
 754
 755 # Getopt::Long Configuration.
 756 sub Configure (@) {
 757     my (@options) = @_;
 758     my $opt;
 759     foreach $opt ( @options ) {
 760         my $try = lc ($opt);
 761         my $action = 1;
 762         if ( $try =~ /^no_?(.*)$/s ) {
 763             $action = 0;
 764             $try = $+;
 765         }
 766         if ( $try eq 'default' or $try eq 'defaults' ) {
 767             ConfigDefaults () if $action;
 768         }
 769         elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
 770             $autoabbrev = $action;
 771         }
 772         elsif ( $try eq 'getopt_compat' ) {
 773             $getopt_compat = $action;
 774         }
 775         elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
 776             $ignorecase = $action;
 777         }
 778         elsif ( $try eq 'ignore_case_always' ) {
 779             $ignorecase = $action ? 2 : 0;
 780         }
 781         elsif ( $try eq 'bundling' ) {
 782             $bundling = $action;
 783         }
 784         elsif ( $try eq 'bundling_override' ) {
 785             $bundling = $action ? 2 : 0;
 786         }
 787         elsif ( $try eq 'require_order' ) {
 788             $order = $action ? $REQUIRE_ORDER : $PERMUTE;
 789         }
 790         elsif ( $try eq 'permute' ) {
 791             $order = $action ? $PERMUTE : $REQUIRE_ORDER;
 792         }
 793         elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
 794             $passthrough = $action;
 795         }
 796         elsif ( $try =~ /^prefix=(.+)$/ ) {
 797             $genprefix = $1;
 798             # Turn into regexp. Needs to be parenthesized!
 799             $genprefix = "(" . quotemeta($genprefix) . ")";
 800             eval { '' =~ /$genprefix/; };
 801             Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
 802         }
 803         elsif ( $try =~ /^prefix_pattern=(.+)$/ ) {
 804             $genprefix = $1;
 805             # Parenthesize if needed.
 806             $genprefix = "(" . $genprefix . ")"
 807               unless $genprefix =~ /^\(.*\)$/;
 808             eval { '' =~ /$genprefix/; };
 809             Croak ("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
 810         }
 811         elsif ( $try eq 'debug' ) {
 812             $debug = $action;
 813         }
 814         else {
 815             Croak ("Getopt::Long: unknown config parameter \"$opt\"")
 816         }
 817     }
 818 }
 819
 820 # Deprecated name.
 821 sub config (@) {
 822     Configure (@_);
 823 }
 824
 825 # To prevent Carp from being loaded unnecessarily.
 826 sub Croak (@) {
 827     require 'Carp.pm';
 828     $Carp::CarpLevel = 1;
 829     Carp::croak(@_);
 830 };
 831
 832 ################ Documentation ################
 833
 834 =head1 NAME
 835
 836 GetOptions - extended processing of command line options
 837
 838 =head1 SYNOPSIS
 839
 840   use Getopt::Long;
 841   $result = GetOptions (...option-descriptions...);
 842
 843 =head1 DESCRIPTION
 844
 845 The Getopt::Long module implements an extended getopt function called
 846 GetOptions(). This function adheres to the POSIX syntax for command
 847 line options, with GNU extensions. In general, this means that options
 848 have long names instead of single letters, and are introduced with a
 849 double dash "--". Support for bundling of command line options, as was
 850 the case with the more traditional single-letter approach, is provided
 851 but not enabled by default. For example, the UNIX "ps" command can be
 852 given the command line "option"
 853
 854   -vax
 855
 856 which means the combination of B<-v>, B<-a> and B<-x>. With the new
 857 syntax B<--vax> would be a single option, probably indicating a
 858 computer architecture.
 859
 860 Command line options can be used to set values. These values can be
 861 specified in one of two ways:
 862
 863   --size 24
 864   --size=24
 865
 866 GetOptions is called with a list of option-descriptions, each of which
 867 consists of two elements: the option specifier and the option linkage.
 868 The option specifier defines the name of the option and, optionally,
 869 the value it can take. The option linkage is usually a reference to a
 870 variable that will be set when the option is used. For example, the
 871 following call to GetOptions:
 872
 873   GetOptions("size=i" => \$offset);
 874
 875 will accept a command line option "size" that must have an integer
 876 value. With a command line of "--size 24" this will cause the variable
 877 $offset to get the value 24.
 878
 879 Alternatively, the first argument to GetOptions may be a reference to
 880 a HASH describing the linkage for the options, or an object whose
 881 class is based on a HASH. The following call is equivalent to the
 882 example above:
 883
 884   %optctl = ("size" => \$offset);
 885   GetOptions(\%optctl, "size=i");
 886
 887 Linkage may be specified using either of the above methods, or both.
 888 Linkage specified in the argument list takes precedence over the
 889 linkage specified in the HASH.
 890
 891 The command line options are taken from array @ARGV. Upon completion
 892 of GetOptions, @ARGV will contain the rest (i.e. the non-options) of
 893 the command line.
 894
 895 Each option specifier designates the name of the option, optionally
 896 followed by an argument specifier.
 897
 898 Options that do not take arguments will have no argument specifier.
 899 The option variable will be set to 1 if the option is used.
 900
 901 For the other options, the values for argument specifiers are:
 902
 903 =over 8
 904
 905 =item !
 906
 907 Option does not take an argument and may be negated, i.e. prefixed by
 908 "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo>
 909 (with value 0).
 910 The option variable will be set to 1, or 0 if negated.
 911
 912 =item +
 913
 914 Option does not take an argument and will be incremented by 1 every
 915 time it appears on the command line. E.g. "more+", when used with
 916 B<--more --more --more>, will set the option variable to 3 (provided
 917 it was 0 or undefined at first).
 918
 919 The B<+> specifier is ignored if the option destination is not a SCALAR.
 920
 921 =item =s
 922
 923 Option takes a mandatory string argument.
 924 This string will be assigned to the option variable.
 925 Note that even if the string argument starts with B<-> or B<-->, it
 926 will not be considered an option on itself.
 927
 928 =item :s
 929
 930 Option takes an optional string argument.
 931 This string will be assigned to the option variable.
 932 If omitted, it will be assigned "" (an empty string).
 933 If the string argument starts with B<-> or B<-->, it
 934 will be considered an option on itself.
 935
 936 =item =i
 937
 938 Option takes a mandatory integer argument.
 939 This value will be assigned to the option variable.
 940 Note that the value may start with B<-> to indicate a negative
 941 value.
 942
 943 =item :i
 944
 945 Option takes an optional integer argument.
 946 This value will be assigned to the option variable.
 947 If omitted, the value 0 will be assigned.
 948 Note that the value may start with B<-> to indicate a negative
 949 value.
 950
 951 =item =f
 952
 953 Option takes a mandatory real number argument.
 954 This value will be assigned to the option variable.
 955 Note that the value may start with B<-> to indicate a negative
 956 value.
 957
 958 =item :f
 959
 960 Option takes an optional real number argument.
 961 This value will be assigned to the option variable.
 962 If omitted, the value 0 will be assigned.
 963
 964 =back
 965
 966 A lone dash B<-> is considered an option, the corresponding option
 967 name is the empty string.
 968
 969 A double dash on itself B<--> signals end of the options list.
 970
 971 =head2 Linkage specification
 972
 973 The linkage specifier is optional. If no linkage is explicitly
 974 specified but a ref HASH is passed, GetOptions will place the value in
 975 the HASH. For example:
 976
 977   %optctl = ();
 978   GetOptions (\%optctl, "size=i");
 979
 980 will perform the equivalent of the assignment
 981
 982   $optctl{"size"} = 24;
 983
 984 For array options, a reference to an array is used, e.g.:
 985
 986   %optctl = ();
 987   GetOptions (\%optctl, "sizes=i@");
 988
 989 with command line "-sizes 24 -sizes 48" will perform the equivalent of
 990 the assignment
 991
 992   $optctl{"sizes"} = [24, 48];
 993
 994 For hash options (an option whose argument looks like "name=value"),
 995 a reference to a hash is used, e.g.:
 996
 997   %optctl = ();
 998   GetOptions (\%optctl, "define=s%");
 999
1000 with command line "--define foo=hello --define bar=world" will perform the
1001 equivalent of the assignment
1002
1003   $optctl{"define"} = {foo=>'hello', bar=>'world')
1004
1005 If no linkage is explicitly specified and no ref HASH is passed,
1006 GetOptions will put the value in a global variable named after the
1007 option, prefixed by "opt_". To yield a usable Perl variable,
1008 characters that are not part of the syntax for variables are
1009 translated to underscores. For example, "--fpp-struct-return" will set
1010 the variable $opt_fpp_struct_return. Note that this variable resides
1011 in the namespace of the calling program, not necessarily B<main>.
1012 For example:
1013
1014   GetOptions ("size=i", "sizes=i@");
1015
1016 with command line "-size 10 -sizes 24 -sizes 48" will perform the
1017 equivalent of the assignments
1018
1019   $opt_size = 10;
1020   @opt_sizes = (24, 48);
1021
1022 A lone dash B<-> is considered an option, the corresponding Perl
1023 identifier is $opt_ .
1024
1025 The linkage specifier can be a reference to a scalar, a reference to
1026 an array, a reference to a hash or a reference to a subroutine.
1027
1028 Note that, if your code is running under the recommended C<use strict
1029 'vars'> pragma, it may be helpful to declare these package variables
1030 via C<use vars> perhaps something like this:
1031
1032   use vars qw/ $opt_size @opt_sizes $opt_bar /;
1033
1034 If a REF SCALAR is supplied, the new value is stored in the referenced
1035 variable. If the option occurs more than once, the previous value is
1036 overwritten.
1037
1038 If a REF ARRAY is supplied, the new value is appended (pushed) to the
1039 referenced array.
1040
1041 If a REF HASH is supplied, the option value should look like "key" or
1042 "key=value" (if the "=value" is omitted then a value of 1 is implied).
1043 In this case, the element of the referenced hash with the key "key"
1044 is assigned "value".
1045
1046 If a REF CODE is supplied, the referenced subroutine is called with
1047 two arguments: the option name and the option value.
1048 The option name is always the true name, not an abbreviation or alias.
1049
1050 =head2 Aliases and abbreviations
1051
1052 The option name may actually be a list of option names, separated by
1053 "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name
1054 of this option. If no linkage is specified, options "foo", "bar" and
1055 "blech" all will set $opt_foo. For convenience, the single character
1056 "?" is allowed as an alias, e.g. "help|?".
1057
1058 Option names may be abbreviated to uniqueness, depending on
1059 configuration option B<auto_abbrev>.
1060
1061 =head2 Non-option call-back routine
1062
1063 A special option specifier, E<lt>E<gt>, can be used to designate a subroutine
1064 to handle non-option arguments. GetOptions will immediately call this
1065 subroutine for every non-option it encounters in the options list.
1066 This subroutine gets the name of the non-option passed.
1067 This feature requires configuration option B<permute>, see section
1068 CONFIGURATION OPTIONS.
1069
1070 See also the examples.
1071
1072 =head2 Option starters
1073
1074 On the command line, options can start with B<-> (traditional), B<-->
1075 (POSIX) and B<+> (GNU, now being phased out). The latter is not
1076 allowed if the environment variable B<POSIXLY_CORRECT> has been
1077 defined.
1078
1079 Options that start with "--" may have an argument appended, separated
1080 with an "=", e.g. "--foo=bar".
1081
1082 =head2 Return values and Errors
1083
1084 Configuration errors and errors in the option definitions are
1085 signalled using C<die()> and will terminate the calling
1086 program unless the call to C<Getopt::Long::GetOptions()> was embedded
1087 in C<eval { ... }> or C<die()> was trapped using C<$SIG{__DIE__}>.
1088
1089 A return value of 1 (true) indicates success.
1090
1091 A return status of 0 (false) indicates that the function detected one
1092 or more errors during option parsing. These errors are signalled using
1093 C<warn()> and can be trapped with C<$SIG{__WARN__}>.
1094
1095 Errors that can't happen are signalled using C<Carp::croak()>.
1096
1097 =head1 COMPATIBILITY
1098
1099 Getopt::Long::GetOptions() is the successor of
1100 B<newgetopt.pl> that came with Perl 4. It is fully upward compatible.
1101 In fact, the Perl 5 version of newgetopt.pl is just a wrapper around
1102 the module.
1103
1104 If an "@" sign is appended to the argument specifier, the option is
1105 treated as an array. Value(s) are not set, but pushed into array
1106 @opt_name. If explicit linkage is supplied, this must be a reference
1107 to an ARRAY.
1108
1109 If an "%" sign is appended to the argument specifier, the option is
1110 treated as a hash. Value(s) of the form "name=value" are set by
1111 setting the element of the hash %opt_name with key "name" to "value"
1112 (if the "=value" portion is omitted it defaults to 1). If explicit
1113 linkage is supplied, this must be a reference to a HASH.
1114
1115 If configuration option B<getopt_compat> is set (see section
1116 CONFIGURATION OPTIONS), options that start with "+" or "-" may also
1117 include their arguments, e.g. "+foo=bar". This is for compatiblity
1118 with older implementations of the GNU "getopt" routine.
1119
1120 If the first argument to GetOptions is a string consisting of only
1121 non-alphanumeric characters, it is taken to specify the option starter
1122 characters. Everything starting with one of these characters from the
1123 starter will be considered an option. B<Using a starter argument is
1124 strongly deprecated.>
1125
1126 For convenience, option specifiers may have a leading B<-> or B<-->,
1127 so it is possible to write:
1128
1129    GetOptions qw(-foo=s --bar=i --ar=s);
1130
1131 =head1 EXAMPLES
1132
1133 If the option specifier is "one:i" (i.e. takes an optional integer
1134 argument), then the following situations are handled:
1135
1136    -one -two            -> $opt_one = '', -two is next option
1137    -one -2              -> $opt_one = -2
1138
1139 Also, assume specifiers "foo=s" and "bar:s" :
1140
1141    -bar -xxx            -> $opt_bar = '', '-xxx' is next option
1142    -foo -bar            -> $opt_foo = '-bar'
1143    -foo --              -> $opt_foo = '--'
1144
1145 In GNU or POSIX format, option names and values can be combined:
1146
1147    +foo=blech           -> $opt_foo = 'blech'
1148    --bar=               -> $opt_bar = ''
1149    --bar=--             -> $opt_bar = '--'
1150
1151 Example of using variable references:
1152
1153    $ret = GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar);
1154
1155 With command line options "-foo blech -bar 24 -ar xx -ar yy"
1156 this will result in:
1157
1158    $foo = 'blech'
1159    $opt_bar = 24
1160    @ar = ('xx','yy')
1161
1162 Example of using the E<lt>E<gt> option specifier:
1163
1164    @ARGV = qw(-foo 1 bar -foo 2 blech);
1165    GetOptions("foo=i", \$myfoo, "<>", \&mysub);
1166
1167 Results:
1168
1169    mysub("bar") will be called (with $myfoo being 1)
1170    mysub("blech") will be called (with $myfoo being 2)
1171
1172 Compare this with:
1173
1174    @ARGV = qw(-foo 1 bar -foo 2 blech);
1175    GetOptions("foo=i", \$myfoo);
1176
1177 This will leave the non-options in @ARGV:
1178
1179    $myfoo -> 2
1180    @ARGV -> qw(bar blech)
1181
1182 =head1 CONFIGURATION OPTIONS
1183
1184 B<GetOptions> can be configured by calling subroutine
1185 B<Getopt::Long::Configure>. This subroutine takes a list of quoted
1186 strings, each specifying a configuration option to be set, e.g.
1187 B<ignore_case>. Options can be reset by prefixing with B<no_>, e.g.
1188 B<no_ignore_case>. Case does not matter. Multiple calls to B<config>
1189 are possible.
1190
1191 Previous versions of Getopt::Long used variables for the purpose of
1192 configuring. Although manipulating these variables still work, it
1193 is strongly encouraged to use the new B<config> routine. Besides, it
1194 is much easier.
1195
1196 The following options are available:
1197
1198 =over 12
1199
1200 =item default
1201
1202 This option causes all configuration options to be reset to their
1203 default values.
1204
1205 =item auto_abbrev
1206
1207 Allow option names to be abbreviated to uniqueness.
1208 Default is set unless environment variable
1209 POSIXLY_CORRECT has been set, in which case B<auto_abbrev> is reset.
1210
1211 =item getopt_compat
1212
1213 Allow '+' to start options.
1214 Default is set unless environment variable
1215 POSIXLY_CORRECT has been set, in which case B<getopt_compat> is reset.
1216
1217 =item require_order
1218
1219 Whether non-options are allowed to be mixed with
1220 options.
1221 Default is set unless environment variable
1222 POSIXLY_CORRECT has been set, in which case b<require_order> is reset.
1223
1224 See also B<permute>, which is the opposite of B<require_order>.
1225
1226 =item permute
1227
1228 Whether non-options are allowed to be mixed with
1229 options.
1230 Default is set unless environment variable
1231 POSIXLY_CORRECT has been set, in which case B<permute> is reset.
1232 Note that B<permute> is the opposite of B<require_order>.
1233
1234 If B<permute> is set, this means that
1235
1236     -foo arg1 -bar arg2 arg3
1237
1238 is equivalent to
1239
1240     -foo -bar arg1 arg2 arg3
1241
1242 If a non-option call-back routine is specified, @ARGV will always be
1243 empty upon succesful return of GetOptions since all options have been
1244 processed, except when B<--> is used:
1245
1246     -foo arg1 -bar arg2 -- arg3
1247
1248 will call the call-back routine for arg1 and arg2, and terminate
1249 leaving arg2 in @ARGV.
1250
1251 If B<require_order> is set, options processing
1252 terminates when the first non-option is encountered.
1253
1254     -foo arg1 -bar arg2 arg3
1255
1256 is equivalent to
1257
1258     -foo -- arg1 -bar arg2 arg3
1259
1260 =item bundling (default: reset)
1261
1262 Setting this variable to a non-zero value will allow single-character
1263 options to be bundled. To distinguish bundles from long option names,
1264 long options must be introduced with B<--> and single-character
1265 options (and bundles) with B<->. For example,
1266
1267     ps -vax --vax
1268
1269 would be equivalent to
1270
1271     ps -v -a -x --vax
1272
1273 provided "vax", "v", "a" and "x" have been defined to be valid
1274 options.
1275
1276 Bundled options can also include a value in the bundle; for strings
1277 this value is the rest of the bundle, but integer and floating values
1278 may be combined in the bundle, e.g.
1279
1280     scale -h24w80
1281
1282 is equivalent to
1283
1284     scale -h 24 -w 80
1285
1286 Note: resetting B<bundling> also resets B<bundling_override>.
1287
1288 =item bundling_override (default: reset)
1289
1290 If B<bundling_override> is set, bundling is enabled as with
1291 B<bundling> but now long option names override option bundles. In the
1292 above example, B<-vax> would be interpreted as the option "vax", not
1293 the bundle "v", "a", "x".
1294
1295 Note: resetting B<bundling_override> also resets B<bundling>.
1296
1297 B<Note:> Using option bundling can easily lead to unexpected results,
1298 especially when mixing long options and bundles. Caveat emptor.
1299
1300 =item ignore_case  (default: set)
1301
1302 If set, case is ignored when matching options.
1303
1304 Note: resetting B<ignore_case> also resets B<ignore_case_always>.
1305
1306 =item ignore_case_always (default: reset)
1307
1308 When bundling is in effect, case is ignored on single-character
1309 options also.
1310
1311 Note: resetting B<ignore_case_always> also resets B<ignore_case>.
1312
1313 =item pass_through (default: reset)
1314
1315 Unknown options are passed through in @ARGV instead of being flagged
1316 as errors. This makes it possible to write wrapper scripts that
1317 process only part of the user supplied options, and passes the
1318 remaining options to some other program.
1319
1320 This can be very confusing, especially when B<permute> is also set.
1321
1322 =item prefix
1323
1324 The string that starts options. See also B<prefix_pattern>.
1325
1326 =item prefix_pattern
1327
1328 A Perl pattern that identifies the strings that introduce options.
1329 Default is C<(--|-|\+)> unless environment variable
1330 POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1331
1332 =item debug (default: reset)
1333
1334 Enable copious debugging output.
1335
1336 =back
1337
1338 =head1 OTHER USEFUL VARIABLES
1339
1340 =over 12
1341
1342 =item $Getopt::Long::VERSION
1343
1344 The version number of this Getopt::Long implementation in the format
1345 C<major>.C<minor>. This can be used to have Exporter check the
1346 version, e.g.
1347
1348     use Getopt::Long 3.00;
1349
1350 You can inspect $Getopt::Long::major_version and
1351 $Getopt::Long::minor_version for the individual components.
1352
1353 =item $Getopt::Long::error
1354
1355 Internal error flag. May be incremented from a call-back routine to
1356 cause options parsing to fail.
1357
1358 =back
1359
1360 =head1 AUTHOR
1361
1362 Johan Vromans E<lt>jvromans@squirrel.nlE<gt>
1363
1364 =head1 COPYRIGHT AND DISCLAIMER
1365
1366 This program is Copyright 1990,1998 by Johan Vromans.
1367 This program is free software; you can redistribute it and/or
1368 modify it under the terms of the GNU General Public License
1369 as published by the Free Software Foundation; either version 2
1370 of the License, or (at your option) any later version.
1371
1372 This program is distributed in the hope that it will be useful,
1373 but WITHOUT ANY WARRANTY; without even the implied warranty of
1374 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1375 GNU General Public License for more details.
1376
1377 If you do not have a copy of the GNU General Public License write to
1378 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
1379 MA 02139, USA.
1380
1381 =cut