lib/Getopt/Long.pm

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