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