lib/Getopt/Long.pm

   1 # GetOpt::Long.pm -- Universal options parsing
   2
   3 package Getopt::Long;
   4
   5 # RCS Status      : $Id: GetoptLong.pm,v 2.58 2002-06-20 09:32:09+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: Thu Jun 20 07:48:05 2002
  10 # Update Count    : 1083
  11 # Status          : Released
  12
  13 ################ Copyright ################
  14
  15 # This program is Copyright 1990,2002 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 5.004;
  34
  35 use strict;
  36
  37 use vars qw($VERSION);
  38 $VERSION        =  2.32;
  39 # For testing versions only.
  40 use vars qw($VERSION_STRING);
  41 $VERSION_STRING = "2.32";
  42
  43 use Exporter;
  44
  45 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  46 @ISA = qw(Exporter);
  47 %EXPORT_TAGS = qw();
  48 BEGIN {
  49     # Init immediately so their contents can be used in the 'use vars' below.
  50     @EXPORT      = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
  51     @EXPORT_OK   = qw();
  52 }
  53
  54 # User visible variables.
  55 use vars @EXPORT, @EXPORT_OK;
  56 use vars qw($error $debug $major_version $minor_version);
  57 # Deprecated visible variables.
  58 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  59             $passthrough);
  60 # Official invisible variables.
  61 use vars qw($genprefix $caller $gnu_compat);
  62
  63 # Public subroutines.
  64 sub Configure (@);
  65 sub config (@);                 # deprecated name
  66 sub GetOptions;
  67
  68 # Private subroutines.
  69 sub ConfigDefaults ();
  70 sub ParseOptionSpec ($$);
  71 sub OptCtl ($);
  72 sub FindOption ($$$$);
  73
  74 ################ Local Variables ################
  75
  76 ################ Resident subroutines ################
  77
  78 sub ConfigDefaults () {
  79     # Handle POSIX compliancy.
  80     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  81         $genprefix = "(--|-)";
  82         $autoabbrev = 0;                # no automatic abbrev of options
  83         $bundling = 0;                  # no bundling of single letter switches
  84         $getopt_compat = 0;             # disallow '+' to start options
  85         $order = $REQUIRE_ORDER;
  86     }
  87     else {
  88         $genprefix = "(--|-|\\+)";
  89         $autoabbrev = 1;                # automatic abbrev of options
  90         $bundling = 0;                  # bundling off by default
  91         $getopt_compat = 1;             # allow '+' to start options
  92         $order = $PERMUTE;
  93     }
  94     # Other configurable settings.
  95     $debug = 0;                 # for debugging
  96     $error = 0;                 # error tally
  97     $ignorecase = 1;            # ignore case when matching options
  98     $passthrough = 0;           # leave unrecognized options alone
  99     $gnu_compat = 0;            # require --opt=val if value is optional
 100 }
 101
 102 # Override import.
 103 sub import {
 104     my $pkg = shift;            # package
 105     my @syms = ();              # symbols to import
 106     my @config = ();            # configuration
 107     my $dest = \@syms;          # symbols first
 108     for ( @_ ) {
 109         if ( $_ eq ':config' ) {
 110             $dest = \@config;   # config next
 111             next;
 112         }
 113         push (@$dest, $_);      # push
 114     }
 115     # Hide one level and call super.
 116     local $Exporter::ExportLevel = 1;
 117     $pkg->SUPER::import(@syms);
 118     # And configure.
 119     Configure (@config) if @config;
 120 }
 121
 122 ################ Initialization ################
 123
 124 # Values for $order. See GNU getopt.c for details.
 125 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
 126 # Version major/minor numbers.
 127 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
 128
 129 ConfigDefaults();
 130
 131 ################ OO Interface ################
 132
 133 package Getopt::Long::Parser;
 134
 135 # Store a copy of the default configuration. Since ConfigDefaults has
 136 # just been called, what we get from Configure is the default.
 137 my $default_config = do {
 138     Getopt::Long::Configure ()
 139 };
 140
 141 sub new {
 142     my $that = shift;
 143     my $class = ref($that) || $that;
 144     my %atts = @_;
 145
 146     # Register the callers package.
 147     my $self = { caller_pkg => (caller)[0] };
 148
 149     bless ($self, $class);
 150
 151     # Process config attributes.
 152     if ( defined $atts{config} ) {
 153         my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
 154         $self->{settings} = Getopt::Long::Configure ($save);
 155         delete ($atts{config});
 156     }
 157     # Else use default config.
 158     else {
 159         $self->{settings} = $default_config;
 160     }
 161
 162     if ( %atts ) {              # Oops
 163         die(__PACKAGE__.": unhandled attributes: ".
 164             join(" ", sort(keys(%atts)))."\n");
 165     }
 166
 167     $self;
 168 }
 169
 170 sub configure {
 171     my ($self) = shift;
 172
 173     # Restore settings, merge new settings in.
 174     my $save = Getopt::Long::Configure ($self->{settings}, @_);
 175
 176     # Restore orig config and save the new config.
 177     $self->{settings} = Getopt::Long::Configure ($save);
 178 }
 179
 180 sub getoptions {
 181     my ($self) = shift;
 182
 183     # Restore config settings.
 184     my $save = Getopt::Long::Configure ($self->{settings});
 185
 186     # Call main routine.
 187     my $ret = 0;
 188     $Getopt::Long::caller = $self->{caller_pkg};
 189
 190     eval {
 191         # Locally set exception handler to default, otherwise it will
 192         # be called implicitly here, and again explicitly when we try
 193         # to deliver the messages.
 194         local ($SIG{__DIE__}) = '__DEFAULT__';
 195         $ret = Getopt::Long::GetOptions (@_);
 196     };
 197
 198     # Restore saved settings.
 199     Getopt::Long::Configure ($save);
 200
 201     # Handle errors and return value.
 202     die ($@) if $@;
 203     return $ret;
 204 }
 205
 206 package Getopt::Long;
 207
 208 # Indices in option control info.
 209 # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
 210 use constant CTL_TYPE    => 0;
 211 #use constant   CTL_TYPE_FLAG   => '';
 212 #use constant   CTL_TYPE_NEG    => '!';
 213 #use constant   CTL_TYPE_INCR   => '+';
 214 #use constant   CTL_TYPE_INT    => 'i';
 215 #use constant   CTL_TYPE_INTINC => 'I';
 216 #use constant   CTL_TYPE_XINT   => 'o';
 217 #use constant   CTL_TYPE_FLOAT  => 'f';
 218 #use constant   CTL_TYPE_STRING => 's';
 219
 220 use constant CTL_CNAME   => 1;
 221
 222 use constant CTL_MAND    => 2;
 223
 224 use constant CTL_DEST    => 3;
 225  use constant   CTL_DEST_SCALAR => 0;
 226  use constant   CTL_DEST_ARRAY  => 1;
 227  use constant   CTL_DEST_HASH   => 2;
 228  use constant   CTL_DEST_CODE   => 3;
 229
 230 use constant CTL_DEFAULT => 4;
 231
 232 # FFU.
 233 #use constant CTL_RANGE   => ;
 234 #use constant CTL_REPEAT  => ;
 235
 236 sub GetOptions {
 237
 238     my @optionlist = @_;        # local copy of the option descriptions
 239     my $argend = '--';          # option list terminator
 240     my %opctl = ();             # table of option specs
 241     my $pkg = $caller || (caller)[0];   # current context
 242                                 # Needed if linkage is omitted.
 243     my @ret = ();               # accum for non-options
 244     my %linkage;                # linkage
 245     my $userlinkage;            # user supplied HASH
 246     my $opt;                    # current option
 247     my $prefix = $genprefix;    # current prefix
 248
 249     $error = '';
 250
 251     print STDERR ("GetOpt::Long $Getopt::Long::VERSION (",
 252                   '$Revision: 2.58 $', ") ",
 253                   "called from package \"$pkg\".",
 254                   "\n  ",
 255                   "ARGV: (@ARGV)",
 256                   "\n  ",
 257                   "autoabbrev=$autoabbrev,".
 258                   "bundling=$bundling,",
 259                   "getopt_compat=$getopt_compat,",
 260                   "gnu_compat=$gnu_compat,",
 261                   "order=$order,",
 262                   "\n  ",
 263                   "ignorecase=$ignorecase,",
 264                   "passthrough=$passthrough,",
 265                   "genprefix=\"$genprefix\".",
 266                   "\n")
 267         if $debug;
 268
 269     # Check for ref HASH as first argument.
 270     # First argument may be an object. It's OK to use this as long
 271     # as it is really a hash underneath.
 272     $userlinkage = undef;
 273     if ( @optionlist && ref($optionlist[0]) and
 274          "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
 275         $userlinkage = shift (@optionlist);
 276         print STDERR ("=> user linkage: $userlinkage\n") if $debug;
 277     }
 278
 279     # See if the first element of the optionlist contains option
 280     # starter characters.
 281     # Be careful not to interpret '<>' as option starters.
 282     if ( @optionlist && $optionlist[0] =~ /^\W+$/
 283          && !($optionlist[0] eq '<>'
 284               && @optionlist > 0
 285               && ref($optionlist[1])) ) {
 286         $prefix = shift (@optionlist);
 287         # Turn into regexp. Needs to be parenthesized!
 288         $prefix =~ s/(\W)/\\$1/g;
 289         $prefix = "([" . $prefix . "])";
 290         print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
 291     }
 292
 293     # Verify correctness of optionlist.
 294     %opctl = ();
 295     while ( @optionlist ) {
 296         my $opt = shift (@optionlist);
 297
 298         # Strip leading prefix so people can specify "--foo=i" if they like.
 299         $opt = $+ if $opt =~ /^$prefix+(.*)$/s;
 300
 301         if ( $opt eq '<>' ) {
 302             if ( (defined $userlinkage)
 303                 && !(@optionlist > 0 && ref($optionlist[0]))
 304                 && (exists $userlinkage->{$opt})
 305                 && ref($userlinkage->{$opt}) ) {
 306                 unshift (@optionlist, $userlinkage->{$opt});
 307             }
 308             unless ( @optionlist > 0
 309                     && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
 310                 $error .= "Option spec <> requires a reference to a subroutine\n";
 311                 # Kill the linkage (to avoid another error).
 312                 shift (@optionlist)
 313                   if @optionlist && ref($optionlist[0]);
 314                 next;
 315             }
 316             $linkage{'<>'} = shift (@optionlist);
 317             next;
 318         }
 319
 320         # Parse option spec.
 321         my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
 322         unless ( defined $name ) {
 323             # Failed. $orig contains the error message. Sorry for the abuse.
 324             $error .= $orig;
 325             # Kill the linkage (to avoid another error).
 326             shift (@optionlist)
 327               if @optionlist && ref($optionlist[0]);
 328             next;
 329         }
 330
 331         # If no linkage is supplied in the @optionlist, copy it from
 332         # the userlinkage if available.
 333         if ( defined $userlinkage ) {
 334             unless ( @optionlist > 0 && ref($optionlist[0]) ) {
 335                 if ( exists $userlinkage->{$orig} &&
 336                      ref($userlinkage->{$orig}) ) {
 337                     print STDERR ("=> found userlinkage for \"$orig\": ",
 338                                   "$userlinkage->{$orig}\n")
 339                         if $debug;
 340                     unshift (@optionlist, $userlinkage->{$orig});
 341                 }
 342                 else {
 343                     # Do nothing. Being undefined will be handled later.
 344                     next;
 345                 }
 346             }
 347         }
 348
 349         # Copy the linkage. If omitted, link to global variable.
 350         if ( @optionlist > 0 && ref($optionlist[0]) ) {
 351             print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
 352                 if $debug;
 353             my $rl = ref($linkage{$orig} = shift (@optionlist));
 354
 355             if ( $rl eq "ARRAY" ) {
 356                 $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
 357             }
 358             elsif ( $rl eq "HASH" ) {
 359                 $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
 360             }
 361             elsif ( $rl eq "SCALAR" || $rl eq "CODE" ) {
 362                 # Ok.
 363             }
 364             else {
 365                 $error .= "Invalid option linkage for \"$opt\"\n";
 366             }
 367         }
 368         else {
 369             # Link to global $opt_XXX variable.
 370             # Make sure a valid perl identifier results.
 371             my $ov = $orig;
 372             $ov =~ s/\W/_/g;
 373             if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
 374                 print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
 375                     if $debug;
 376                 eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
 377             }
 378             elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
 379                 print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
 380                     if $debug;
 381                 eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
 382             }
 383             else {
 384                 print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
 385                     if $debug;
 386                 eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
 387             }
 388         }
 389     }
 390
 391     # Bail out if errors found.
 392     die ($error) if $error;
 393     $error = 0;
 394
 395     # Show the options tables if debugging.
 396     if ( $debug ) {
 397         my ($arrow, $k, $v);
 398         $arrow = "=> ";
 399         while ( ($k,$v) = each(%opctl) ) {
 400             print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
 401             $arrow = "   ";
 402         }
 403     }
 404
 405     # Process argument list
 406     my $goon = 1;
 407     while ( $goon && @ARGV > 0 ) {
 408
 409         # Get next argument.
 410         $opt = shift (@ARGV);
 411         print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
 412
 413         # Double dash is option list terminator.
 414         last if $opt eq $argend;
 415
 416         # Look it up.
 417         my $tryopt = $opt;
 418         my $found;              # success status
 419         my $key;                # key (if hash type)
 420         my $arg;                # option argument
 421         my $ctl;                # the opctl entry
 422
 423         ($found, $opt, $ctl, $arg, $key) =
 424           FindOption ($prefix, $argend, $opt, \%opctl);
 425
 426         if ( $found ) {
 427
 428             # FindOption undefines $opt in case of errors.
 429             next unless defined $opt;
 430
 431             if ( defined $arg ) {
 432
 433                 # Get the canonical name.
 434                 print STDERR ("=> cname for \"$opt\" is ") if $debug;
 435                 $opt = $ctl->[CTL_CNAME];
 436                 print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
 437
 438                 if ( defined $linkage{$opt} ) {
 439                     print STDERR ("=> ref(\$L{$opt}) -> ",
 440                                   ref($linkage{$opt}), "\n") if $debug;
 441
 442                     if ( ref($linkage{$opt}) eq 'SCALAR' ) {
 443                         if ( $ctl->[CTL_TYPE] eq '+' ) {
 444                             print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
 445                               if $debug;
 446                             if ( defined ${$linkage{$opt}} ) {
 447                                 ${$linkage{$opt}} += $arg;
 448                             }
 449                             else {
 450                                 ${$linkage{$opt}} = $arg;
 451                             }
 452                         }
 453                         else {
 454                             print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
 455                               if $debug;
 456                             ${$linkage{$opt}} = $arg;
 457                         }
 458                     }
 459                     elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
 460                         print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
 461                             if $debug;
 462                         push (@{$linkage{$opt}}, $arg);
 463                     }
 464                     elsif ( ref($linkage{$opt}) eq 'HASH' ) {
 465                         print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
 466                             if $debug;
 467                         $linkage{$opt}->{$key} = $arg;
 468                     }
 469                     elsif ( ref($linkage{$opt}) eq 'CODE' ) {
 470                         print STDERR ("=> &L{$opt}(\"$opt\"",
 471                                       $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
 472                                       ", \"$arg\")\n")
 473                             if $debug;
 474                         my $eval_error = do {
 475                             local $@;
 476                             local $SIG{__DIE__}  = '__DEFAULT__';
 477                             eval {
 478                                 &{$linkage{$opt}}($opt,
 479                                                   $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
 480                                                   $arg);
 481                             };
 482                             $@;
 483                         };
 484                         print STDERR ("=> die($eval_error)\n")
 485                           if $debug && $eval_error ne '';
 486                         if ( $eval_error =~ /^!/ ) {
 487                             if ( $eval_error =~ /^!FINISH\b/ ) {
 488                                 $goon = 0;
 489                             }
 490                         }
 491                         elsif ( $eval_error ne '' ) {
 492                             warn ($eval_error);
 493                             $error++;
 494                         }
 495                     }
 496                     else {
 497                         print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
 498                                       "\" in linkage\n");
 499                         die("Getopt::Long -- internal error!\n");
 500                     }
 501                 }
 502                 # No entry in linkage means entry in userlinkage.
 503                 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
 504                     if ( defined $userlinkage->{$opt} ) {
 505                         print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
 506                             if $debug;
 507                         push (@{$userlinkage->{$opt}}, $arg);
 508                     }
 509                     else {
 510                         print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
 511                             if $debug;
 512                         $userlinkage->{$opt} = [$arg];
 513                     }
 514                 }
 515                 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
 516                     if ( defined $userlinkage->{$opt} ) {
 517                         print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
 518                             if $debug;
 519                         $userlinkage->{$opt}->{$key} = $arg;
 520                     }
 521                     else {
 522                         print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
 523                             if $debug;
 524                         $userlinkage->{$opt} = {$key => $arg};
 525                     }
 526                 }
 527                 else {
 528                     if ( $ctl->[CTL_TYPE] eq '+' ) {
 529                         print STDERR ("=> \$L{$opt} += \"$arg\"\n")
 530                           if $debug;
 531                         if ( defined $userlinkage->{$opt} ) {
 532                             $userlinkage->{$opt} += $arg;
 533                         }
 534                         else {
 535                             $userlinkage->{$opt} = $arg;
 536                         }
 537                     }
 538                     else {
 539                         print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
 540                         $userlinkage->{$opt} = $arg;
 541                     }
 542                 }
 543             }
 544         }
 545
 546         # Not an option. Save it if we $PERMUTE and don't have a <>.
 547         elsif ( $order == $PERMUTE ) {
 548             # Try non-options call-back.
 549             my $cb;
 550             if ( (defined ($cb = $linkage{'<>'})) ) {
 551                 print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
 552                   if $debug;
 553                 my $eval_error = do {
 554                     local $@;
 555                     local $SIG{__DIE__}  = '__DEFAULT__';
 556                     eval { &$cb ($tryopt) };
 557                     $@;
 558                 };
 559                 print STDERR ("=> die($eval_error)\n")
 560                   if $debug && $eval_error ne '';
 561                 if ( $eval_error =~ /^!/ ) {
 562                     if ( $eval_error =~ /^!FINISH\b/ ) {
 563                         $goon = 0;
 564                     }
 565                 }
 566                 elsif ( $eval_error ne '' ) {
 567                     warn ($eval_error);
 568                     $error++;
 569                 }
 570             }
 571             else {
 572                 print STDERR ("=> saving \"$tryopt\" ",
 573                               "(not an option, may permute)\n") if $debug;
 574                 push (@ret, $tryopt);
 575             }
 576             next;
 577         }
 578
 579         # ...otherwise, terminate.
 580         else {
 581             # Push this one back and exit.
 582             unshift (@ARGV, $tryopt);
 583             return ($error == 0);
 584         }
 585
 586     }
 587
 588     # Finish.
 589     if ( @ret && $order == $PERMUTE ) {
 590         #  Push back accumulated arguments
 591         print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
 592             if $debug;
 593         unshift (@ARGV, @ret);
 594     }
 595
 596     return ($error == 0);
 597 }
 598
 599 # A readable representation of what's in an optbl.
 600 sub OptCtl ($) {
 601     my ($v) = @_;
 602     my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
 603     "[".
 604       join(",",
 605            "\"$v[CTL_TYPE]\"",
 606            "\"$v[CTL_CNAME]\"",
 607            $v[CTL_MAND] ? "O" : "M",
 608            ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
 609            "\"$v[CTL_DEFAULT]\"",
 610 #          $v[CTL_RANGE] || '',
 611 #          $v[CTL_REPEAT] || '',
 612           ). "]";
 613 }
 614
 615 # Parse an option specification and fill the tables.
 616 sub ParseOptionSpec ($$) {
 617     my ($opt, $opctl) = @_;
 618
 619     # Match option spec.
 620     if ( $opt !~ m;^
 621                    (
 622                      # Option name
 623                      (?: \w+[-\w]* )
 624                      # Alias names, or "?"
 625                      (?: \| (?: \? | \w[-\w]* )? )*
 626                    )?
 627                    (
 628                      # Either modifiers ...
 629                      [!+]
 630                      |
 631                      # ... or a value/dest specification
 632                      [=:] [ionfs] [@%]?
 633                      |
 634                      # ... or an optional-with-default spec
 635                      : (?: -?\d+ | \+ ) [@%]?
 636                    )?
 637                    $;x ) {
 638         return (undef, "Error in option spec: \"$opt\"\n");
 639     }
 640
 641     my ($names, $spec) = ($1, $2);
 642     $spec = '' unless defined $spec;
 643
 644     # $orig keeps track of the primary name the user specified.
 645     # This name will be used for the internal or external linkage.
 646     # In other words, if the user specifies "FoO|BaR", it will
 647     # match any case combinations of 'foo' and 'bar', but if a global
 648     # variable needs to be set, it will be $opt_FoO in the exact case
 649     # as specified.
 650     my $orig;
 651
 652     my @names;
 653     if ( defined $names ) {
 654         @names =  split (/\|/, $names);
 655         $orig = $names[0];
 656     }
 657     else {
 658         @names = ('');
 659         $orig = '';
 660     }
 661
 662     # Construct the opctl entries.
 663     my $entry;
 664     if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
 665         # Fields are hard-wired here.
 666         $entry = [$spec,$orig,0,CTL_DEST_SCALAR,undef];
 667     }
 668     elsif ( $spec =~ /:(-?\d+|\+)([@%])?/ ) {
 669         my $def = $1;
 670         my $dest = $2;
 671         my $type = $def eq '+' ? 'I' : 'i';
 672         $dest ||= '$';
 673         $dest = $dest eq '@' ? CTL_DEST_ARRAY
 674           : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
 675         # Fields are hard-wired here.
 676         $entry = [$type,$orig,0,$dest,$def eq '+' ? undef : $def];
 677     }
 678     else {
 679         my ($mand, $type, $dest) = $spec =~ /([=:])([ionfs])([@%])?/;
 680         $type = 'i' if $type eq 'n';
 681         $dest ||= '$';
 682         $dest = $dest eq '@' ? CTL_DEST_ARRAY
 683           : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
 684         # Fields are hard-wired here.
 685         $entry = [$type,$orig,$mand eq '=',$dest,undef];
 686     }
 687
 688     # Process all names. First is canonical, the rest are aliases.
 689     my $dups = '';
 690     foreach ( @names ) {
 691
 692         $_ = lc ($_)
 693           if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
 694
 695         if ( exists $opctl->{$_} ) {
 696             $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
 697         }
 698
 699         if ( $spec eq '!' ) {
 700             $opctl->{"no$_"} = $entry;
 701             $opctl->{$_} = [@$entry];
 702             $opctl->{$_}->[CTL_TYPE] = '';
 703         }
 704         else {
 705             $opctl->{$_} = $entry;
 706         }
 707     }
 708
 709     if ( $dups && $^W ) {
 710         foreach ( split(/\n+/, $dups) ) {
 711             warn($_."\n");
 712         }
 713     }
 714     ($names[0], $orig);
 715 }
 716
 717 # Option lookup.
 718 sub FindOption ($$$$) {
 719
 720     # returns (1, $opt, $ctl, $arg, $key) if okay,
 721     # returns (1, undef) if option in error,
 722     # returns (0) otherwise.
 723
 724     my ($prefix, $argend, $opt, $opctl) = @_;
 725
 726     print STDERR ("=> find \"$opt\"\n") if $debug;
 727
 728     return (0) unless $opt =~ /^$prefix(.*)$/s;
 729     return (0) if $opt eq "-" && !defined $opctl->{''};
 730
 731     $opt = $+;
 732     my $starter = $1;
 733
 734     print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
 735
 736     my $optarg;                 # value supplied with --opt=value
 737     my $rest;                   # remainder from unbundling
 738
 739     # If it is a long option, it may include the value.
 740     # With getopt_compat, only if not bundling.
 741     if ( ($starter eq "--"
 742           || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
 743           && $opt =~ /^([^=]+)=(.*)$/s ) {
 744         $opt = $1;
 745         $optarg = $2;
 746         print STDERR ("=> option \"", $opt,
 747                       "\", optarg = \"$optarg\"\n") if $debug;
 748     }
 749
 750     #### Look it up ###
 751
 752     my $tryopt = $opt;          # option to try
 753
 754     if ( $bundling && $starter eq '-' ) {
 755
 756         # To try overrides, obey case ignore.
 757         $tryopt = $ignorecase ? lc($opt) : $opt;
 758
 759         # If bundling == 2, long options can override bundles.
 760         if ( $bundling == 2 && length($tryopt) > 1
 761              && defined ($opctl->{$tryopt}) ) {
 762             print STDERR ("=> $starter$tryopt overrides unbundling\n")
 763               if $debug;
 764         }
 765         else {
 766             $tryopt = $opt;
 767             # Unbundle single letter option.
 768             $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
 769             $tryopt = substr ($tryopt, 0, 1);
 770             $tryopt = lc ($tryopt) if $ignorecase > 1;
 771             print STDERR ("=> $starter$tryopt unbundled from ",
 772                           "$starter$tryopt$rest\n") if $debug;
 773             $rest = undef unless $rest ne '';
 774         }
 775     }
 776
 777     # Try auto-abbreviation.
 778     elsif ( $autoabbrev ) {
 779         # Sort the possible long option names.
 780         my @names = sort(keys (%$opctl));
 781         # Downcase if allowed.
 782         $opt = lc ($opt) if $ignorecase;
 783         $tryopt = $opt;
 784         # Turn option name into pattern.
 785         my $pat = quotemeta ($opt);
 786         # Look up in option names.
 787         my @hits = grep (/^$pat/, @names);
 788         print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
 789                       "out of ", scalar(@names), "\n") if $debug;
 790
 791         # Check for ambiguous results.
 792         unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
 793             # See if all matches are for the same option.
 794             my %hit;
 795             foreach ( @hits ) {
 796                 $_ = $opctl->{$_}->[CTL_CNAME]
 797                   if defined $opctl->{$_}->[CTL_CNAME];
 798                 $hit{$_} = 1;
 799             }
 800             # Now see if it really is ambiguous.
 801             unless ( keys(%hit) == 1 ) {
 802                 return (0) if $passthrough;
 803                 warn ("Option ", $opt, " is ambiguous (",
 804                       join(", ", @hits), ")\n");
 805                 $error++;
 806                 return (1, undef);
 807             }
 808             @hits = keys(%hit);
 809         }
 810
 811         # Complete the option name, if appropriate.
 812         if ( @hits == 1 && $hits[0] ne $opt ) {
 813             $tryopt = $hits[0];
 814             $tryopt = lc ($tryopt) if $ignorecase;
 815             print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
 816                 if $debug;
 817         }
 818     }
 819
 820     # Map to all lowercase if ignoring case.
 821     elsif ( $ignorecase ) {
 822         $tryopt = lc ($opt);
 823     }
 824
 825     # Check validity by fetching the info.
 826     my $ctl = $opctl->{$tryopt};
 827     unless  ( defined $ctl ) {
 828         return (0) if $passthrough;
 829         warn ("Unknown option: ", $opt, "\n");
 830         $error++;
 831         return (1, undef);
 832     }
 833     # Apparently valid.
 834     $opt = $tryopt;
 835     print STDERR ("=> found ", OptCtl($ctl),
 836                   " for \"", $opt, "\"\n") if $debug;
 837
 838     #### Determine argument status ####
 839
 840     # If it is an option w/o argument, we're almost finished with it.
 841     my $type = $ctl->[CTL_TYPE];
 842     my $arg;
 843
 844     if ( $type eq '' || $type eq '!' || $type eq '+' ) {
 845         if ( defined $optarg ) {
 846             return (0) if $passthrough;
 847             warn ("Option ", $opt, " does not take an argument\n");
 848             $error++;
 849             undef $opt;
 850         }
 851         elsif ( $type eq '' || $type eq '+' ) {
 852             # Supply explicit value.
 853             $arg = 1;
 854         }
 855         else {
 856             $opt =~ s/^no//i;   # strip NO prefix
 857             $arg = 0;           # supply explicit value
 858         }
 859         unshift (@ARGV, $starter.$rest) if defined $rest;
 860         return (1, $opt, $ctl, $arg);
 861     }
 862
 863     # Get mandatory status and type info.
 864     my $mand = $ctl->[CTL_MAND];
 865
 866     # Check if there is an option argument available.
 867     if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
 868         return (1, $opt, $ctl, $type eq 's' ? '' : 0) unless $mand;
 869         $optarg = 0 unless $type eq 's';
 870     }
 871
 872     # Check if there is an option argument available.
 873     if ( defined $optarg
 874          ? ($optarg eq '')
 875          : !(defined $rest || @ARGV > 0) ) {
 876         # Complain if this option needs an argument.
 877         if ( $mand ) {
 878             return (0) if $passthrough;
 879             warn ("Option ", $opt, " requires an argument\n");
 880             $error++;
 881             return (1, undef);
 882         }
 883         if ( $type eq 'I' ) {
 884             # Fake incremental type.
 885             my @c = @$ctl;
 886             $c[CTL_TYPE] = '+';
 887             return (1, $opt, \@c, 1);
 888         }
 889         return (1, $opt, $ctl,
 890                 defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
 891                 $type eq 's' ? '' : 0);
 892     }
 893
 894     # Get (possibly optional) argument.
 895     $arg = (defined $rest ? $rest
 896             : (defined $optarg ? $optarg : shift (@ARGV)));
 897
 898     # Get key if this is a "name=value" pair for a hash option.
 899     my $key;
 900     if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
 901         ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
 902           : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 1);
 903     }
 904
 905     #### Check if the argument is valid for this option ####
 906
 907     if ( $type eq 's' ) {       # string
 908         # A mandatory string takes anything.
 909         return (1, $opt, $ctl, $arg, $key) if $mand;
 910
 911         # An optional string takes almost anything.
 912         return (1, $opt, $ctl, $arg, $key)
 913           if defined $optarg || defined $rest;
 914         return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
 915
 916         # Check for option or option list terminator.
 917         if ($arg eq $argend ||
 918             $arg =~ /^$prefix.+/) {
 919             # Push back.
 920             unshift (@ARGV, $arg);
 921             # Supply empty value.
 922             $arg = '';
 923         }
 924     }
 925
 926     elsif ( $type eq 'i'        # numeric/integer
 927             || $type eq 'I'     # numeric/integer w/ incr default
 928             || $type eq 'o' ) { # dec/oct/hex/bin value
 929
 930         my $o_valid =
 931           $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
 932             : "[-+]?[0-9]+";
 933
 934         if ( $bundling && defined $rest && $rest =~ /^($o_valid)(.*)$/si ) {
 935             $arg = $1;
 936             $rest = $2;
 937             $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
 938             unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 939         }
 940         elsif ( $arg =~ /^($o_valid)$/si ) {
 941             $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
 942         }
 943         else {
 944             if ( defined $optarg || $mand ) {
 945                 if ( $passthrough ) {
 946                     unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 947                       unless defined $optarg;
 948                     return (0);
 949                 }
 950                 warn ("Value \"", $arg, "\" invalid for option ",
 951                       $opt, " (",
 952                       $type eq 'o' ? "extended " : '',
 953                       "number expected)\n");
 954                 $error++;
 955                 # Push back.
 956                 unshift (@ARGV, $starter.$rest) if defined $rest;
 957                 return (1, undef);
 958             }
 959             else {
 960                 # Push back.
 961                 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
 962                 if ( $type eq 'I' ) {
 963                     # Fake incremental type.
 964                     my @c = @$ctl;
 965                     $c[CTL_TYPE] = '+';
 966                     return (1, $opt, \@c, 1);
 967                 }
 968                 # Supply default value.
 969                 $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
 970             }
 971         }
 972     }
 973
 974     elsif ( $type eq 'f' ) { # real number, int is also ok
 975         # We require at least one digit before a point or 'e',
 976         # and at least one digit following the point and 'e'.
 977         # [-]NN[.NN][eNN]
 978         if ( $bundling && defined $rest &&
 979              $rest =~ /^([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
 980             $arg = $1;
 981             $rest = $+;
 982             unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
 983         }
 984         elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
 985             if ( defined $optarg || $mand ) {
 986                 if ( $passthrough ) {
 987                     unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
 988                       unless defined $optarg;
 989                     return (0);
 990                 }
 991                 warn ("Value \"", $arg, "\" invalid for option ",
 992                       $opt, " (real number expected)\n");
 993                 $error++;
 994                 # Push back.
 995                 unshift (@ARGV, $starter.$rest) if defined $rest;
 996                 return (1, undef);
 997             }
 998             else {
 999                 # Push back.
1000                 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1001                 # Supply default value.
1002                 $arg = 0.0;
1003             }
1004         }
1005     }
1006     else {
1007         die("GetOpt::Long internal error (Can't happen)\n");
1008     }
1009     return (1, $opt, $ctl, $arg, $key);
1010 }
1011
1012 # Getopt::Long Configuration.
1013 sub Configure (@) {
1014     my (@options) = @_;
1015
1016     my $prevconfig =
1017       [ $error, $debug, $major_version, $minor_version,
1018         $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1019         $gnu_compat, $passthrough, $genprefix ];
1020
1021     if ( ref($options[0]) eq 'ARRAY' ) {
1022         ( $error, $debug, $major_version, $minor_version,
1023           $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1024           $gnu_compat, $passthrough, $genprefix ) = @{shift(@options)};
1025     }
1026
1027     my $opt;
1028     foreach $opt ( @options ) {
1029         my $try = lc ($opt);
1030         my $action = 1;
1031         if ( $try =~ /^no_?(.*)$/s ) {
1032             $action = 0;
1033             $try = $+;
1034         }
1035         if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
1036             ConfigDefaults ();
1037         }
1038         elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
1039             local $ENV{POSIXLY_CORRECT};
1040             $ENV{POSIXLY_CORRECT} = 1 if $action;
1041             ConfigDefaults ();
1042         }
1043         elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
1044             $autoabbrev = $action;
1045         }
1046         elsif ( $try eq 'getopt_compat' ) {
1047             $getopt_compat = $action;
1048         }
1049         elsif ( $try eq 'gnu_getopt' ) {
1050             if ( $action ) {
1051                 $gnu_compat = 1;
1052                 $bundling = 1;
1053                 $getopt_compat = 0;
1054                 $order = $PERMUTE;
1055             }
1056         }
1057         elsif ( $try eq 'gnu_compat' ) {
1058             $gnu_compat = $action;
1059         }
1060         elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
1061             $ignorecase = $action;
1062         }
1063         elsif ( $try eq 'ignore_case_always' ) {
1064             $ignorecase = $action ? 2 : 0;
1065         }
1066         elsif ( $try eq 'bundling' ) {
1067             $bundling = $action;
1068         }
1069         elsif ( $try eq 'bundling_override' ) {
1070             $bundling = $action ? 2 : 0;
1071         }
1072         elsif ( $try eq 'require_order' ) {
1073             $order = $action ? $REQUIRE_ORDER : $PERMUTE;
1074         }
1075         elsif ( $try eq 'permute' ) {
1076             $order = $action ? $PERMUTE : $REQUIRE_ORDER;
1077         }
1078         elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
1079             $passthrough = $action;
1080         }
1081         elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
1082             $genprefix = $1;
1083             # Turn into regexp. Needs to be parenthesized!
1084             $genprefix = "(" . quotemeta($genprefix) . ")";
1085             eval { '' =~ /$genprefix/; };
1086             die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
1087         }
1088         elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
1089             $genprefix = $1;
1090             # Parenthesize if needed.
1091             $genprefix = "(" . $genprefix . ")"
1092               unless $genprefix =~ /^\(.*\)$/;
1093             eval { '' =~ /$genprefix/; };
1094             die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
1095         }
1096         elsif ( $try eq 'debug' ) {
1097             $debug = $action;
1098         }
1099         else {
1100             die("Getopt::Long: unknown config parameter \"$opt\"")
1101         }
1102     }
1103     $prevconfig;
1104 }
1105
1106 # Deprecated name.
1107 sub config (@) {
1108     Configure (@_);
1109 }
1110
1111 ################ Documentation ################
1112
1113 =head1 NAME
1114
1115 Getopt::Long - Extended processing of command line options
1116
1117 =head1 SYNOPSIS
1118
1119   use Getopt::Long;
1120   my $data   = "file.dat";
1121   my $length = 24;
1122   my $verbose;
1123   $result = GetOptions ("length=i" => \$length,    # numeric
1124                         "file=s"   => \$data,      # string
1125                         "verbose"  => \$verbose);  # flag
1126
1127 =head1 DESCRIPTION
1128
1129 The Getopt::Long module implements an extended getopt function called
1130 GetOptions(). This function adheres to the POSIX syntax for command
1131 line options, with GNU extensions. In general, this means that options
1132 have long names instead of single letters, and are introduced with a
1133 double dash "--". Support for bundling of command line options, as was
1134 the case with the more traditional single-letter approach, is provided
1135 but not enabled by default.
1136
1137 =head1 Command Line Options, an Introduction
1138
1139 Command line operated programs traditionally take their arguments from
1140 the command line, for example filenames or other information that the
1141 program needs to know. Besides arguments, these programs often take
1142 command line I<options> as well. Options are not necessary for the
1143 program to work, hence the name 'option', but are used to modify its
1144 default behaviour. For example, a program could do its job quietly,
1145 but with a suitable option it could provide verbose information about
1146 what it did.
1147
1148 Command line options come in several flavours. Historically, they are
1149 preceded by a single dash C<->, and consist of a single letter.
1150
1151     -l -a -c
1152
1153 Usually, these single-character options can be bundled:
1154
1155     -lac
1156
1157 Options can have values, the value is placed after the option
1158 character. Sometimes with whitespace in between, sometimes not:
1159
1160     -s 24 -s24
1161
1162 Due to the very cryptic nature of these options, another style was
1163 developed that used long names. So instead of a cryptic C<-l> one
1164 could use the more descriptive C<--long>. To distinguish between a
1165 bundle of single-character options and a long one, two dashes are used
1166 to precede the option name. Early implementations of long options used
1167 a plus C<+> instead. Also, option values could be specified either
1168 like
1169
1170     --size=24
1171
1172 or
1173
1174     --size 24
1175
1176 The C<+> form is now obsolete and strongly deprecated.
1177
1178 =head1 Getting Started with Getopt::Long
1179
1180 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
1181 the first Perl module that provided support for handling the new style
1182 of command line options, hence the name Getopt::Long. This module
1183 also supports single-character options and bundling. In this case, the
1184 options are restricted to alphabetic characters only, and the
1185 characters C<?> and C<->.
1186
1187 To use Getopt::Long from a Perl program, you must include the
1188 following line in your Perl program:
1189
1190     use Getopt::Long;
1191
1192 This will load the core of the Getopt::Long module and prepare your
1193 program for using it. Most of the actual Getopt::Long code is not
1194 loaded until you really call one of its functions.
1195
1196 In the default configuration, options names may be abbreviated to
1197 uniqueness, case does not matter, and a single dash is sufficient,
1198 even for long option names. Also, options may be placed between
1199 non-option arguments. See L<Configuring Getopt::Long> for more
1200 details on how to configure Getopt::Long.
1201
1202 =head2 Simple options
1203
1204 The most simple options are the ones that take no values. Their mere
1205 presence on the command line enables the option. Popular examples are:
1206
1207     --all --verbose --quiet --debug
1208
1209 Handling simple options is straightforward:
1210
1211     my $verbose = '';   # option variable with default value (false)
1212     my $all = '';       # option variable with default value (false)
1213     GetOptions ('verbose' => \$verbose, 'all' => \$all);
1214
1215 The call to GetOptions() parses the command line arguments that are
1216 present in C<@ARGV> and sets the option variable to the value C<1> if
1217 the option did occur on the command line. Otherwise, the option
1218 variable is not touched. Setting the option value to true is often
1219 called I<enabling> the option.
1220
1221 The option name as specified to the GetOptions() function is called
1222 the option I<specification>. Later we'll see that this specification
1223 can contain more than just the option name. The reference to the
1224 variable is called the option I<destination>.
1225
1226 GetOptions() will return a true value if the command line could be
1227 processed successfully. Otherwise, it will write error messages to
1228 STDERR, and return a false result.
1229
1230 =head2 A little bit less simple options
1231
1232 Getopt::Long supports two useful variants of simple options:
1233 I<negatable> options and I<incremental> options.
1234
1235 A negatable option is specified with an exclamation mark C<!> after the
1236 option name:
1237
1238     my $verbose = '';   # option variable with default value (false)
1239     GetOptions ('verbose!' => \$verbose);
1240
1241 Now, using C<--verbose> on the command line will enable C<$verbose>,
1242 as expected. But it is also allowed to use C<--noverbose>, which will
1243 disable C<$verbose> by setting its value to C<0>. Using a suitable
1244 default value, the program can find out whether C<$verbose> is false
1245 by default, or disabled by using C<--noverbose>.
1246
1247 An incremental option is specified with a plus C<+> after the
1248 option name:
1249
1250     my $verbose = '';   # option variable with default value (false)
1251     GetOptions ('verbose+' => \$verbose);
1252
1253 Using C<--verbose> on the command line will increment the value of
1254 C<$verbose>. This way the program can keep track of how many times the
1255 option occurred on the command line. For example, each occurrence of
1256 C<--verbose> could increase the verbosity level of the program.
1257
1258 =head2 Mixing command line option with other arguments
1259
1260 Usually programs take command line options as well as other arguments,
1261 for example, file names. It is good practice to always specify the
1262 options first, and the other arguments last. Getopt::Long will,
1263 however, allow the options and arguments to be mixed and 'filter out'
1264 all the options before passing the rest of the arguments to the
1265 program. To stop Getopt::Long from processing further arguments,
1266 insert a double dash C<--> on the command line:
1267
1268     --size 24 -- --all
1269
1270 In this example, C<--all> will I<not> be treated as an option, but
1271 passed to the program unharmed, in C<@ARGV>.
1272
1273 =head2 Options with values
1274
1275 For options that take values it must be specified whether the option
1276 value is required or not, and what kind of value the option expects.
1277
1278 Three kinds of values are supported: integer numbers, floating point
1279 numbers, and strings.
1280
1281 If the option value is required, Getopt::Long will take the
1282 command line argument that follows the option and assign this to the
1283 option variable. If, however, the option value is specified as
1284 optional, this will only be done if that value does not look like a
1285 valid command line option itself.
1286
1287     my $tag = '';       # option variable with default value
1288     GetOptions ('tag=s' => \$tag);
1289
1290 In the option specification, the option name is followed by an equals
1291 sign C<=> and the letter C<s>. The equals sign indicates that this
1292 option requires a value. The letter C<s> indicates that this value is
1293 an arbitrary string. Other possible value types are C<i> for integer
1294 values, and C<f> for floating point values. Using a colon C<:> instead
1295 of the equals sign indicates that the option value is optional. In
1296 this case, if no suitable value is supplied, string valued options get
1297 an empty string C<''> assigned, while numeric options are set to C<0>.
1298
1299 =head2 Options with multiple values
1300
1301 Options sometimes take several values. For example, a program could
1302 use multiple directories to search for library files:
1303
1304     --library lib/stdlib --library lib/extlib
1305
1306 To accomplish this behaviour, simply specify an array reference as the
1307 destination for the option:
1308
1309     my @libfiles = ();
1310     GetOptions ("library=s" => \@libfiles);
1311
1312 Used with the example above, C<@libfiles> would contain two strings
1313 upon completion: C<"lib/srdlib"> and C<"lib/extlib">, in that order.
1314 It is also possible to specify that only integer or floating point
1315 numbers are acceptible values.
1316
1317 Often it is useful to allow comma-separated lists of values as well as
1318 multiple occurrences of the options. This is easy using Perl's split()
1319 and join() operators:
1320
1321     my @libfiles = ();
1322     GetOptions ("library=s" => \@libfiles);
1323     @libfiles = split(/,/,join(',',@libfiles));
1324
1325 Of course, it is important to choose the right separator string for
1326 each purpose.
1327
1328 =head2 Options with hash values
1329
1330 If the option destination is a reference to a hash, the option will
1331 take, as value, strings of the form I<key>C<=>I<value>. The value will
1332 be stored with the specified key in the hash.
1333
1334     my %defines = ();
1335     GetOptions ("define=s" => \%defines);
1336
1337 When used with command line options:
1338
1339     --define os=linux --define vendor=redhat
1340
1341 the hash C<%defines> will contain two keys, C<"os"> with value
1342 C<"linux> and C<"vendor"> with value C<"redhat">.
1343 It is also possible to specify that only integer or floating point
1344 numbers are acceptible values. The keys are always taken to be strings.
1345
1346 =head2 User-defined subroutines to handle options
1347
1348 Ultimate control over what should be done when (actually: each time)
1349 an option is encountered on the command line can be achieved by
1350 designating a reference to a subroutine (or an anonymous subroutine)
1351 as the option destination. When GetOptions() encounters the option, it
1352 will call the subroutine with two or three arguments. The first
1353 argument is the name of the option. For a scalar or array destination,
1354 the second argument is the value to be stored. For a hash destination,
1355 the second arguments is the key to the hash, and the third argument
1356 the value to be stored. It is up to the subroutine to store the value,
1357 or do whatever it thinks is appropriate.
1358
1359 A trivial application of this mechanism is to implement options that
1360 are related to each other. For example:
1361
1362     my $verbose = '';   # option variable with default value (false)
1363     GetOptions ('verbose' => \$verbose,
1364                 'quiet'   => sub { $verbose = 0 });
1365
1366 Here C<--verbose> and C<--quiet> control the same variable
1367 C<$verbose>, but with opposite values.
1368
1369 If the subroutine needs to signal an error, it should call die() with
1370 the desired error message as its argument. GetOptions() will catch the
1371 die(), issue the error message, and record that an error result must
1372 be returned upon completion.
1373
1374 If the text of the error message starts with an exclamantion mark C<!>
1375 it is interpreted specially by GetOptions(). There is currently one
1376 special command implemented: C<die("!FINISH")> will cause GetOptions()
1377 to stop processing options, as if it encountered a double dash C<-->.
1378
1379 =head2 Options with multiple names
1380
1381 Often it is user friendly to supply alternate mnemonic names for
1382 options. For example C<--height> could be an alternate name for
1383 C<--length>. Alternate names can be included in the option
1384 specification, separated by vertical bar C<|> characters. To implement
1385 the above example:
1386
1387     GetOptions ('length|height=f' => \$length);
1388
1389 The first name is called the I<primary> name, the other names are
1390 called I<aliases>.
1391
1392 Multiple alternate names are possible.
1393
1394 =head2 Case and abbreviations
1395
1396 Without additional configuration, GetOptions() will ignore the case of
1397 option names, and allow the options to be abbreviated to uniqueness.
1398
1399     GetOptions ('length|height=f' => \$length, "head" => \$head);
1400
1401 This call will allow C<--l> and C<--L> for the length option, but
1402 requires a least C<--hea> and C<--hei> for the head and height options.
1403
1404 =head2 Summary of Option Specifications
1405
1406 Each option specifier consists of two parts: the name specification
1407 and the argument specification.
1408
1409 The name specification contains the name of the option, optionally
1410 followed by a list of alternative names separated by vertical bar
1411 characters.
1412
1413     length            option name is "length"
1414     length|size|l     name is "length", aliases are "size" and "l"
1415
1416 The argument specification is optional. If omitted, the option is
1417 considered boolean, a value of 1 will be assigned when the option is
1418 used on the command line.
1419
1420 The argument specification can be
1421
1422 =over 4
1423
1424 =item !
1425
1426 The option does not take an argument and may be negated, i.e. prefixed
1427 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
1428 assigned) and C<--nofoo> (a value of 0 will be assigned). If the
1429 option has aliases, this applies to the aliases as well.
1430
1431 Using negation on a single letter option when bundling is in effect is
1432 pointless and will result in a warning.
1433
1434 =item +
1435
1436 The option does not take an argument and will be incremented by 1
1437 every time it appears on the command line. E.g. C<"more+">, when used
1438 with C<--more --more --more>, will increment the value three times,
1439 resulting in a value of 3 (provided it was 0 or undefined at first).
1440
1441 The C<+> specifier is ignored if the option destination is not a scalar.
1442
1443 =item = I<type> [ I<desttype> ]
1444
1445 The option requires an argument of the given type. Supported types
1446 are:
1447
1448 =over 4
1449
1450 =item s
1451
1452 String. An arbitrary sequence of characters. It is valid for the
1453 argument to start with C<-> or C<-->.
1454
1455 =item i
1456
1457 Integer. An optional leading plus or minus sign, followed by a
1458 sequence of digits.
1459
1460 =item o
1461
1462 Extended integer, Perl style. This can be either an optional leading
1463 plus or minus sign, followed by a sequence of digits, or an octal
1464 string (a zero, optionally followed by '0', '1', .. '7'), or a
1465 hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
1466 insensitive), or a binary string (C<0b> followed by a series of '0'
1467 and '1').
1468
1469 =item f
1470
1471 Real number. For example C<3.14>, C<-6.23E24> and so on.
1472
1473 =back
1474
1475 The I<desttype> can be C<@> or C<%> to specify that the option is
1476 list or a hash valued. This is only needed when the destination for
1477 the option value is not otherwise specified. It should be omitted when
1478 not needed.
1479
1480 =item : I<type> [ I<desttype> ]
1481
1482 Like C<=>, but designates the argument as optional.
1483 If omitted, an empty string will be assigned to string values options,
1484 and the value zero to numeric options.
1485
1486 Note that if a string argument starts with C<-> or C<-->, it will be
1487 considered an option on itself.
1488
1489 =item : I<number> [ I<desttype> ]
1490
1491 Like C<:i>, but if the value is omitted, the I<number> will be assigned.
1492
1493 =item : + [ I<desttype> ]
1494
1495 Like C<:i>, but if the value is omitted, the current value for the
1496 option will be incremented.
1497
1498 =back
1499
1500 =head1 Advanced Possibilities
1501
1502 =head2 Object oriented interface
1503
1504 Getopt::Long can be used in an object oriented way as well:
1505
1506     use Getopt::Long;
1507     $p = new Getopt::Long::Parser;
1508     $p->configure(...configuration options...);
1509     if ($p->getoptions(...options descriptions...)) ...
1510
1511 Configuration options can be passed to the constructor:
1512
1513     $p = new Getopt::Long::Parser
1514              config => [...configuration options...];
1515
1516 =head2 Thread Safety
1517
1518 Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
1519 I<not> thread safe when using the older (experimental and now
1520 obsolete) threads implementation that was added to Perl 5.005.
1521
1522 =head2 Documentation and help texts
1523
1524 Getopt::Long encourages the use of Pod::Usage to produce help
1525 messages. For example:
1526
1527     use Getopt::Long;
1528     use Pod::Usage;
1529
1530     my $man = 0;
1531     my $help = 0;
1532
1533     GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1534     pod2usage(1) if $help;
1535     pod2usage(-exitstatus => 0, -verbose => 2) if $man;
1536
1537     __END__
1538
1539     =head1 NAME
1540
1541     sample - Using GetOpt::Long and Pod::Usage
1542
1543     =head1 SYNOPSIS
1544
1545     sample [options] [file ...]
1546
1547      Options:
1548        -help            brief help message
1549        -man             full documentation
1550
1551     =head1 OPTIONS
1552
1553     =over 8
1554
1555     =item B<-help>
1556
1557     Print a brief help message and exits.
1558
1559     =item B<-man>
1560
1561     Prints the manual page and exits.
1562
1563     =back
1564
1565     =head1 DESCRIPTION
1566
1567     B<This program> will read the given input file(s) and do someting
1568     useful with the contents thereof.
1569
1570     =cut
1571
1572 See L<Pod::Usage> for details.
1573
1574 =head2 Storing options in a hash
1575
1576 Sometimes, for example when there are a lot of options, having a
1577 separate variable for each of them can be cumbersome. GetOptions()
1578 supports, as an alternative mechanism, storing options in a hash.
1579
1580 To obtain this, a reference to a hash must be passed I<as the first
1581 argument> to GetOptions(). For each option that is specified on the
1582 command line, the option value will be stored in the hash with the
1583 option name as key. Options that are not actually used on the command
1584 line will not be put in the hash, on other words,
1585 C<exists($h{option})> (or defined()) can be used to test if an option
1586 was used. The drawback is that warnings will be issued if the program
1587 runs under C<use strict> and uses C<$h{option}> without testing with
1588 exists() or defined() first.
1589
1590     my %h = ();
1591     GetOptions (\%h, 'length=i');       # will store in $h{length}
1592
1593 For options that take list or hash values, it is necessary to indicate
1594 this by appending an C<@> or C<%> sign after the type:
1595
1596     GetOptions (\%h, 'colours=s@');     # will push to @{$h{colours}}
1597
1598 To make things more complicated, the hash may contain references to
1599 the actual destinations, for example:
1600
1601     my $len = 0;
1602     my %h = ('length' => \$len);
1603     GetOptions (\%h, 'length=i');       # will store in $len
1604
1605 This example is fully equivalent with:
1606
1607     my $len = 0;
1608     GetOptions ('length=i' => \$len);   # will store in $len
1609
1610 Any mixture is possible. For example, the most frequently used options
1611 could be stored in variables while all other options get stored in the
1612 hash:
1613
1614     my $verbose = 0;                    # frequently referred
1615     my $debug = 0;                      # frequently referred
1616     my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1617     GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1618     if ( $verbose ) { ... }
1619     if ( exists $h{filter} ) { ... option 'filter' was specified ... }
1620
1621 =head2 Bundling
1622
1623 With bundling it is possible to set several single-character options
1624 at once. For example if C<a>, C<v> and C<x> are all valid options,
1625
1626     -vax
1627
1628 would set all three.
1629
1630 Getopt::Long supports two levels of bundling. To enable bundling, a
1631 call to Getopt::Long::Configure is required.
1632
1633 The first level of bundling can be enabled with:
1634
1635     Getopt::Long::Configure ("bundling");
1636
1637 Configured this way, single-character options can be bundled but long
1638 options B<must> always start with a double dash C<--> to avoid
1639 abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1640 options,
1641
1642     -vax
1643
1644 would set C<a>, C<v> and C<x>, but
1645
1646     --vax
1647
1648 would set C<vax>.
1649
1650 The second level of bundling lifts this restriction. It can be enabled
1651 with:
1652
1653     Getopt::Long::Configure ("bundling_override");
1654
1655 Now, C<-vax> would set the option C<vax>.
1656
1657 When any level of bundling is enabled, option values may be inserted
1658 in the bundle. For example:
1659
1660     -h24w80
1661
1662 is equivalent to
1663
1664     -h 24 -w 80
1665
1666 When configured for bundling, single-character options are matched
1667 case sensitive while long options are matched case insensitive. To
1668 have the single-character options matched case insensitive as well,
1669 use:
1670
1671     Getopt::Long::Configure ("bundling", "ignorecase_always");
1672
1673 It goes without saying that bundling can be quite confusing.
1674
1675 =head2 The lonesome dash
1676
1677 Normally, a lone dash C<-> on the command line will not be considered
1678 an option. Option processing will terminate (unless "permute" is
1679 configured) and the dash will be left in C<@ARGV>.
1680
1681 It is possible to get special treatment for a lone dash. This can be
1682 achieved by adding an option specification with an empty name, for
1683 example:
1684
1685     GetOptions ('' => \$stdio);
1686
1687 A lone dash on the command line will now be a legal option, and using
1688 it will set variable C<$stdio>.
1689
1690 =head2 Argument callback
1691
1692 A special option 'name' C<<>> can be used to designate a subroutine
1693 to handle non-option arguments. When GetOptions() encounters an
1694 argument that does not look like an option, it will immediately call this
1695 subroutine and passes it one parameter: the argument name.
1696
1697 For example:
1698
1699     my $width = 80;
1700     sub process { ... }
1701     GetOptions ('width=i' => \$width, '<>' => \&process);
1702
1703 When applied to the following command line:
1704
1705     arg1 --width=72 arg2 --width=60 arg3
1706
1707 This will call
1708 C<process("arg1")> while C<$width> is C<80>,
1709 C<process("arg2")> while C<$width> is C<72>, and
1710 C<process("arg3")> while C<$width> is C<60>.
1711
1712 This feature requires configuration option B<permute>, see section
1713 L<Configuring Getopt::Long>.
1714
1715
1716 =head1 Configuring Getopt::Long
1717
1718 Getopt::Long can be configured by calling subroutine
1719 Getopt::Long::Configure(). This subroutine takes a list of quoted
1720 strings, each specifying a configuration option to be enabled, e.g.
1721 C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
1722 matter. Multiple calls to Configure() are possible.
1723
1724 Alternatively, as of version 2.24, the configuration options may be
1725 passed together with the C<use> statement:
1726
1727     use Getopt::Long qw(:config no_ignore_case bundling);
1728
1729 The following options are available:
1730
1731 =over 12
1732
1733 =item default
1734
1735 This option causes all configuration options to be reset to their
1736 default values.
1737
1738 =item posix_default
1739
1740 This option causes all configuration options to be reset to their
1741 default values as if the environment variable POSIXLY_CORRECT had
1742 been set.
1743
1744 =item auto_abbrev
1745
1746 Allow option names to be abbreviated to uniqueness.
1747 Default is enabled unless environment variable
1748 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
1749
1750 =item getopt_compat
1751
1752 Allow C<+> to start options.
1753 Default is enabled unless environment variable
1754 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
1755
1756 =item gnu_compat
1757
1758 C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
1759 do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
1760 C<--opt=> will give option C<opt> and empty value.
1761 This is the way GNU getopt_long() does it.
1762
1763 =item gnu_getopt
1764
1765 This is a short way of setting C<gnu_compat> C<bundling> C<permute>
1766 C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
1767 fully compatible with GNU getopt_long().
1768
1769 =item require_order
1770
1771 Whether command line arguments are allowed to be mixed with options.
1772 Default is disabled unless environment variable
1773 POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
1774
1775 See also C<permute>, which is the opposite of C<require_order>.
1776
1777 =item permute
1778
1779 Whether command line arguments are allowed to be mixed with options.
1780 Default is enabled unless environment variable
1781 POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
1782 Note that C<permute> is the opposite of C<require_order>.
1783
1784 If C<permute> is enabled, this means that
1785
1786     --foo arg1 --bar arg2 arg3
1787
1788 is equivalent to
1789
1790     --foo --bar arg1 arg2 arg3
1791
1792 If an argument callback routine is specified, C<@ARGV> will always be
1793 empty upon succesful return of GetOptions() since all options have been
1794 processed. The only exception is when C<--> is used:
1795
1796     --foo arg1 --bar arg2 -- arg3
1797
1798 This will call the callback routine for arg1 and arg2, and then
1799 terminate GetOptions() leaving C<"arg2"> in C<@ARGV>.
1800
1801 If C<require_order> is enabled, options processing
1802 terminates when the first non-option is encountered.
1803
1804     --foo arg1 --bar arg2 arg3
1805
1806 is equivalent to
1807
1808     --foo -- arg1 --bar arg2 arg3
1809
1810 If C<pass_through> is also enabled, options processing will terminate
1811 at the first unrecognized option, or non-option, whichever comes
1812 first.
1813
1814 =item bundling (default: disabled)
1815
1816 Enabling this option will allow single-character options to be
1817 bundled. To distinguish bundles from long option names, long options
1818 I<must> be introduced with C<--> and bundles with C<->.
1819
1820 Note that, if you have options C<a>, C<l> and C<all>, and
1821 auto_abbrev enabled, possible arguments and option settings are:
1822
1823     using argument               sets option(s)
1824     ------------------------------------------
1825     -a, --a                      a
1826     -l, --l                      l
1827     -al, -la, -ala, -all,...     a, l
1828     --al, --all                  all
1829
1830 The suprising part is that C<--a> sets option C<a> (due to auto
1831 completion), not C<all>.
1832
1833 Note: disabling C<bundling> also disables C<bundling_override>.
1834
1835 =item bundling_override (default: disabled)
1836
1837 If C<bundling_override> is enabled, bundling is enabled as with
1838 C<bundling> but now long option names override option bundles.
1839
1840 Note: disabling C<bundling_override> also disables C<bundling>.
1841
1842 B<Note:> Using option bundling can easily lead to unexpected results,
1843 especially when mixing long options and bundles. Caveat emptor.
1844
1845 =item ignore_case  (default: enabled)
1846
1847 If enabled, case is ignored when matching long option names. If,
1848 however, bundling is enabled as well, single character options will be
1849 treated case-sensitive.
1850
1851 With C<ignore_case>, option specifications for options that only
1852 differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
1853 duplicates.
1854
1855 Note: disabling C<ignore_case> also disables C<ignore_case_always>.
1856
1857 =item ignore_case_always (default: disabled)
1858
1859 When bundling is in effect, case is ignored on single-character
1860 options also.
1861
1862 Note: disabling C<ignore_case_always> also disables C<ignore_case>.
1863
1864 =item pass_through (default: disabled)
1865
1866 Options that are unknown, ambiguous or supplied with an invalid option
1867 value are passed through in C<@ARGV> instead of being flagged as
1868 errors. This makes it possible to write wrapper scripts that process
1869 only part of the user supplied command line arguments, and pass the
1870 remaining options to some other program.
1871
1872 If C<require_order> is enabled, options processing will terminate at
1873 the first unrecognized option, or non-option, whichever comes first.
1874 However, if C<permute> is enabled instead, results can become confusing.
1875
1876 =item prefix
1877
1878 The string that starts options. If a constant string is not
1879 sufficient, see C<prefix_pattern>.
1880
1881 =item prefix_pattern
1882
1883 A Perl pattern that identifies the strings that introduce options.
1884 Default is C<(--|-|\+)> unless environment variable
1885 POSIXLY_CORRECT has been set, in which case it is C<(--|-)>.
1886
1887 =item debug (default: disabled)
1888
1889 Enable debugging output.
1890
1891 =back
1892
1893 =head1 Return values and Errors
1894
1895 Configuration errors and errors in the option definitions are
1896 signalled using die() and will terminate the calling program unless
1897 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
1898 }>, or die() was trapped using C<$SIG{__DIE__}>.
1899
1900 GetOptions returns true to indicate success.
1901 It returns false when the function detected one or more errors during
1902 option parsing. These errors are signalled using warn() and can be
1903 trapped with C<$SIG{__WARN__}>.
1904
1905 Errors that can't happen are signalled using Carp::croak().
1906
1907 =head1 Legacy
1908
1909 The earliest development of C<newgetopt.pl> started in 1990, with Perl
1910 version 4. As a result, its development, and the development of
1911 Getopt::Long, has gone through several stages. Since backward
1912 compatibility has always been extremely important, the current version
1913 of Getopt::Long still supports a lot of constructs that nowadays are
1914 no longer necessary or otherwise unwanted. This section describes
1915 briefly some of these 'features'.
1916
1917 =head2 Default destinations
1918
1919 When no destination is specified for an option, GetOptions will store
1920 the resultant value in a global variable named C<opt_>I<XXX>, where
1921 I<XXX> is the primary name of this option. When a progam executes
1922 under C<use strict> (recommended), these variables must be
1923 pre-declared with our() or C<use vars>.
1924
1925     our $opt_length = 0;
1926     GetOptions ('length=i');    # will store in $opt_length
1927
1928 To yield a usable Perl variable, characters that are not part of the
1929 syntax for variables are translated to underscores. For example,
1930 C<--fpp-struct-return> will set the variable
1931 C<$opt_fpp_struct_return>. Note that this variable resides in the
1932 namespace of the calling program, not necessarily C<main>. For
1933 example:
1934
1935     GetOptions ("size=i", "sizes=i@");
1936
1937 with command line "-size 10 -sizes 24 -sizes 48" will perform the
1938 equivalent of the assignments
1939
1940     $opt_size = 10;
1941     @opt_sizes = (24, 48);
1942
1943 =head2 Alternative option starters
1944
1945 A string of alternative option starter characters may be passed as the
1946 first argument (or the first argument after a leading hash reference
1947 argument).
1948
1949     my $len = 0;
1950     GetOptions ('/', 'length=i' => $len);
1951
1952 Now the command line may look like:
1953
1954     /length 24 -- arg
1955
1956 Note that to terminate options processing still requires a double dash
1957 C<-->.
1958
1959 GetOptions() will not interpret a leading C<< "<>" >> as option starters
1960 if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
1961 option starters, use C<< "><" >>. Confusing? Well, B<using a starter
1962 argument is strongly deprecated> anyway.
1963
1964 =head2 Configuration variables
1965
1966 Previous versions of Getopt::Long used variables for the purpose of
1967 configuring. Although manipulating these variables still work, it is
1968 strongly encouraged to use the C<Configure> routine that was introduced
1969 in version 2.17. Besides, it is much easier.
1970
1971 =head1 Trouble Shooting
1972
1973 =head2 Warning: Ignoring '!' modifier for short option
1974
1975 This warning is issued when the '!' modifier is applied to a short
1976 (one-character) option and bundling is in effect. E.g.,
1977
1978     Getopt::Long::Configure("bundling");
1979     GetOptions("foo|f!" => \$foo);
1980
1981 Note that older Getopt::Long versions did not issue a warning, because
1982 the '!' modifier was applied to the first name only. This bug was
1983 fixed in 2.22.
1984
1985 Solution: separate the long and short names and apply the '!' to the
1986 long names only, e.g.,
1987
1988     GetOptions("foo!" => \$foo, "f" => \$foo);
1989
1990 =head2 GetOptions does not return a false result when an option is not supplied
1991
1992 That's why they're called 'options'.
1993
1994 =head2 GetOptions does not split the command line correctly
1995
1996 The command line is not split by GetOptions, but by the command line
1997 interpreter (CLI). On Unix, this is the shell. On Windows, it is
1998 COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
1999
2000 It is important to know that these CLIs may behave different when the
2001 command line contains special characters, in particular quotes or
2002 backslashes. For example, with Unix shells you can use single quotes
2003 (C<'>) and double quotes (C<">) to group words together. The following
2004 alternatives are equivalent on Unix:
2005
2006     "two words"
2007     'two words'
2008     two\ words
2009
2010 In case of doubt, insert the following statement in front of your Perl
2011 program:
2012
2013     print STDERR (join("|",@ARGV),"\n");
2014
2015 to verify how your CLI passes the arguments to the program.
2016
2017 =head2 How do I put a "-?" option into a Getopt::Long?
2018
2019 You can only obtain this using an alias, and Getopt::Long of at least
2020 version 2.13.
2021
2022     use Getopt::Long;
2023     GetOptions ("help|?");    # -help and -? will both set $opt_help
2024
2025 =head1 AUTHOR
2026
2027 Johan Vromans <jvromans@squirrel.nl>
2028
2029 =head1 COPYRIGHT AND DISCLAIMER
2030
2031 This program is Copyright 2002,1990 by Johan Vromans.
2032 This program is free software; you can redistribute it and/or
2033 modify it under the terms of the Perl Artistic License or the
2034 GNU General Public License as published by the Free Software
2035 Foundation; either version 2 of the License, or (at your option) any
2036 later version.
2037
2038 This program is distributed in the hope that it will be useful,
2039 but WITHOUT ANY WARRANTY; without even the implied warranty of
2040 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2041 GNU General Public License for more details.
2042
2043 If you do not have a copy of the GNU General Public License write to
2044 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
2045 MA 02139, USA.
2046
2047 =cut
2048