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