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