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