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