cpan/Getopt-Long/lib/Getopt/Long.pm

   1 #! perl
   2
   3 # Getopt::Long.pm -- Universal options parsing
   4 # Author          : Johan Vromans
   5 # Created On      : Tue Sep 11 15:00:12 1990
   6 # Last Modified By: Johan Vromans
   7 # Last Modified On: Tue Oct  1 08:25:52 2013
   8 # Update Count    : 1651
   9 # Status          : Released
  10
  11 ################ Module Preamble ################
  12
  13 package Getopt::Long;
  14
  15 use 5.004;
  16
  17 use strict;
  18
  19 use vars qw($VERSION);
  20 $VERSION        =  2.42;
  21 # For testing versions only.
  22 use vars qw($VERSION_STRING);
  23 $VERSION_STRING = "2.42";
  24
  25 use Exporter;
  26 use vars qw(@ISA @EXPORT @EXPORT_OK);
  27 @ISA = qw(Exporter);
  28
  29 # Exported subroutines.
  30 sub GetOptions(@);              # always
  31 sub GetOptionsFromArray(@);     # on demand
  32 sub GetOptionsFromString(@);    # on demand
  33 sub Configure(@);               # on demand
  34 sub HelpMessage(@);             # on demand
  35 sub VersionMessage(@);          # in demand
  36
  37 BEGIN {
  38     # Init immediately so their contents can be used in the 'use vars' below.
  39     @EXPORT    = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
  40     @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure
  41                     &GetOptionsFromArray &GetOptionsFromString);
  42 }
  43
  44 # User visible variables.
  45 use vars @EXPORT, @EXPORT_OK;
  46 use vars qw($error $debug $major_version $minor_version);
  47 # Deprecated visible variables.
  48 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
  49             $passthrough);
  50 # Official invisible variables.
  51 use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
  52
  53 # Public subroutines.
  54 sub config(@);                  # deprecated name
  55
  56 # Private subroutines.
  57 sub ConfigDefaults();
  58 sub ParseOptionSpec($$);
  59 sub OptCtl($);
  60 sub FindOption($$$$$);
  61 sub ValidValue ($$$$$);
  62
  63 ################ Local Variables ################
  64
  65 # $requested_version holds the version that was mentioned in the 'use'
  66 # or 'require', if any. It can be used to enable or disable specific
  67 # features.
  68 my $requested_version = 0;
  69
  70 ################ Resident subroutines ################
  71
  72 sub ConfigDefaults() {
  73     # Handle POSIX compliancy.
  74     if ( defined $ENV{"POSIXLY_CORRECT"} ) {
  75         $genprefix = "(--|-)";
  76         $autoabbrev = 0;                # no automatic abbrev of options
  77         $bundling = 0;                  # no bundling of single letter switches
  78         $getopt_compat = 0;             # disallow '+' to start options
  79         $order = $REQUIRE_ORDER;
  80     }
  81     else {
  82         $genprefix = "(--|-|\\+)";
  83         $autoabbrev = 1;                # automatic abbrev of options
  84         $bundling = 0;                  # bundling off by default
  85         $getopt_compat = 1;             # allow '+' to start options
  86         $order = $PERMUTE;
  87     }
  88     # Other configurable settings.
  89     $debug = 0;                 # for debugging
  90     $error = 0;                 # error tally
  91     $ignorecase = 1;            # ignore case when matching options
  92     $passthrough = 0;           # leave unrecognized options alone
  93     $gnu_compat = 0;            # require --opt=val if value is optional
  94     $longprefix = "(--)";       # what does a long prefix look like
  95 }
  96
  97 # Override import.
  98 sub import {
  99     my $pkg = shift;            # package
 100     my @syms = ();              # symbols to import
 101     my @config = ();            # configuration
 102     my $dest = \@syms;          # symbols first
 103     for ( @_ ) {
 104         if ( $_ eq ':config' ) {
 105             $dest = \@config;   # config next
 106             next;
 107         }
 108         push(@$dest, $_);       # push
 109     }
 110     # Hide one level and call super.
 111     local $Exporter::ExportLevel = 1;
 112     push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
 113     $requested_version = 0;
 114     $pkg->SUPER::import(@syms);
 115     # And configure.
 116     Configure(@config) if @config;
 117 }
 118
 119 ################ Initialization ################
 120
 121 # Values for $order. See GNU getopt.c for details.
 122 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
 123 # Version major/minor numbers.
 124 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
 125
 126 ConfigDefaults();
 127
 128 ################ OO Interface ################
 129
 130 package Getopt::Long::Parser;
 131
 132 # Store a copy of the default configuration. Since ConfigDefaults has
 133 # just been called, what we get from Configure is the default.
 134 my $default_config = do {
 135     Getopt::Long::Configure ()
 136 };
 137
 138 sub new {
 139     my $that = shift;
 140     my $class = ref($that) || $that;
 141     my %atts = @_;
 142
 143     # Register the callers package.
 144     my $self = { caller_pkg => (caller)[0] };
 145
 146     bless ($self, $class);
 147
 148     # Process config attributes.
 149     if ( defined $atts{config} ) {
 150         my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
 151         $self->{settings} = Getopt::Long::Configure ($save);
 152         delete ($atts{config});
 153     }
 154     # Else use default config.
 155     else {
 156         $self->{settings} = $default_config;
 157     }
 158
 159     if ( %atts ) {              # Oops
 160         die(__PACKAGE__.": unhandled attributes: ".
 161             join(" ", sort(keys(%atts)))."\n");
 162     }
 163
 164     $self;
 165 }
 166
 167 sub configure {
 168     my ($self) = shift;
 169
 170     # Restore settings, merge new settings in.
 171     my $save = Getopt::Long::Configure ($self->{settings}, @_);
 172
 173     # Restore orig config and save the new config.
 174     $self->{settings} = Getopt::Long::Configure ($save);
 175 }
 176
 177 sub getoptions {
 178     my ($self) = shift;
 179
 180     return $self->getoptionsfromarray(\@ARGV, @_);
 181 }
 182
 183 sub getoptionsfromarray {
 184     my ($self) = shift;
 185
 186     # Restore config settings.
 187     my $save = Getopt::Long::Configure ($self->{settings});
 188
 189     # Call main routine.
 190     my $ret = 0;
 191     $Getopt::Long::caller = $self->{caller_pkg};
 192
 193     eval {
 194         # Locally set exception handler to default, otherwise it will
 195         # be called implicitly here, and again explicitly when we try
 196         # to deliver the messages.
 197         local ($SIG{__DIE__}) = 'DEFAULT';
 198         $ret = Getopt::Long::GetOptionsFromArray (@_);
 199     };
 200
 201     # Restore saved settings.
 202     Getopt::Long::Configure ($save);
 203
 204     # Handle errors and return value.
 205     die ($@) if $@;
 206     return $ret;
 207 }
 208
 209 package Getopt::Long;
 210
 211 ################ Back to Normal ################
 212
 213 # Indices in option control info.
 214 # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
 215 use constant CTL_TYPE    => 0;
 216 #use constant   CTL_TYPE_FLAG   => '';
 217 #use constant   CTL_TYPE_NEG    => '!';
 218 #use constant   CTL_TYPE_INCR   => '+';
 219 #use constant   CTL_TYPE_INT    => 'i';
 220 #use constant   CTL_TYPE_INTINC => 'I';
 221 #use constant   CTL_TYPE_XINT   => 'o';
 222 #use constant   CTL_TYPE_FLOAT  => 'f';
 223 #use constant   CTL_TYPE_STRING => 's';
 224
 225 use constant CTL_CNAME   => 1;
 226
 227 use constant CTL_DEFAULT => 2;
 228
 229 use constant CTL_DEST    => 3;
 230  use constant   CTL_DEST_SCALAR => 0;
 231  use constant   CTL_DEST_ARRAY  => 1;
 232  use constant   CTL_DEST_HASH   => 2;
 233  use constant   CTL_DEST_CODE   => 3;
 234
 235 use constant CTL_AMIN    => 4;
 236 use constant CTL_AMAX    => 5;
 237
 238 # FFU.
 239 #use constant CTL_RANGE   => ;
 240 #use constant CTL_REPEAT  => ;
 241
 242 # Rather liberal patterns to match numbers.
 243 use constant PAT_INT   => "[-+]?_*[0-9][0-9_]*";
 244 use constant PAT_XINT  =>
 245   "(?:".
 246           "[-+]?_*[1-9][0-9_]*".
 247   "|".
 248           "0x_*[0-9a-f][0-9a-f_]*".
 249   "|".
 250           "0b_*[01][01_]*".
 251   "|".
 252           "0[0-7_]*".
 253   ")";
 254 use constant PAT_FLOAT => "[-+]?[0-9_]+(\.[0-9_]+)?([eE][-+]?[0-9_]+)?";
 255
 256 sub GetOptions(@) {
 257     # Shift in default array.
 258     unshift(@_, \@ARGV);
 259     # Try to keep caller() and Carp consistent.
 260     goto &GetOptionsFromArray;
 261 }
 262
 263 sub GetOptionsFromString(@) {
 264     my ($string) = shift;
 265     require Text::ParseWords;
 266     my $args = [ Text::ParseWords::shellwords($string) ];
 267     $caller ||= (caller)[0];    # current context
 268     my $ret = GetOptionsFromArray($args, @_);
 269     return ( $ret, $args ) if wantarray;
 270     if ( @$args ) {
 271         $ret = 0;
 272         warn("GetOptionsFromString: Excess data \"@$args\" in string \"$string\"\n");
 273     }
 274     $ret;
 275 }
 276
 277 sub GetOptionsFromArray(@) {
 278
 279     my ($argv, @optionlist) = @_;       # local copy of the option descriptions
 280     my $argend = '--';          # option list terminator
 281     my %opctl = ();             # table of option specs
 282     my $pkg = $caller || (caller)[0];   # current context
 283                                 # Needed if linkage is omitted.
 284     my @ret = ();               # accum for non-options
 285     my %linkage;                # linkage
 286     my $userlinkage;            # user supplied HASH
 287     my $opt;                    # current option
 288     my $prefix = $genprefix;    # current prefix
 289
 290     $error = '';
 291
 292     if ( $debug ) {
 293         # Avoid some warnings if debugging.
 294         local ($^W) = 0;
 295         print STDERR
 296           ("Getopt::Long $Getopt::Long::VERSION ",
 297            "called from package \"$pkg\".",
 298            "\n  ",
 299            "argv: (@$argv)",
 300            "\n  ",
 301            "autoabbrev=$autoabbrev,".
 302            "bundling=$bundling,",
 303            "getopt_compat=$getopt_compat,",
 304            "gnu_compat=$gnu_compat,",
 305            "order=$order,",
 306            "\n  ",
 307            "ignorecase=$ignorecase,",
 308            "requested_version=$requested_version,",
 309            "passthrough=$passthrough,",
 310            "genprefix=\"$genprefix\",",
 311            "longprefix=\"$longprefix\".",
 312            "\n");
 313     }
 314
 315     # Check for ref HASH as first argument.
 316     # First argument may be an object. It's OK to use this as long
 317     # as it is really a hash underneath.
 318     $userlinkage = undef;
 319     if ( @optionlist && ref($optionlist[0]) and
 320          UNIVERSAL::isa($optionlist[0],'HASH') ) {
 321         $userlinkage = shift (@optionlist);
 322         print STDERR ("=> user linkage: $userlinkage\n") if $debug;
 323     }
 324
 325     # See if the first element of the optionlist contains option
 326     # starter characters.
 327     # Be careful not to interpret '<>' as option starters.
 328     if ( @optionlist && $optionlist[0] =~ /^\W+$/
 329          && !($optionlist[0] eq '<>'
 330               && @optionlist > 0
 331               && ref($optionlist[1])) ) {
 332         $prefix = shift (@optionlist);
 333         # Turn into regexp. Needs to be parenthesized!
 334         $prefix =~ s/(\W)/\\$1/g;
 335         $prefix = "([" . $prefix . "])";
 336         print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
 337     }
 338
 339     # Verify correctness of optionlist.
 340     %opctl = ();
 341     while ( @optionlist ) {
 342         my $opt = shift (@optionlist);
 343
 344         unless ( defined($opt) ) {
 345             $error .= "Undefined argument in option spec\n";
 346             next;
 347         }
 348
 349         # Strip leading prefix so people can specify "--foo=i" if they like.
 350         $opt = $+ if $opt =~ /^$prefix+(.*)$/s;
 351
 352         if ( $opt eq '<>' ) {
 353             if ( (defined $userlinkage)
 354                 && !(@optionlist > 0 && ref($optionlist[0]))
 355                 && (exists $userlinkage->{$opt})
 356                 && ref($userlinkage->{$opt}) ) {
 357                 unshift (@optionlist, $userlinkage->{$opt});
 358             }
 359             unless ( @optionlist > 0
 360                     && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
 361                 $error .= "Option spec <> requires a reference to a subroutine\n";
 362                 # Kill the linkage (to avoid another error).
 363                 shift (@optionlist)
 364                   if @optionlist && ref($optionlist[0]);
 365                 next;
 366             }
 367             $linkage{'<>'} = shift (@optionlist);
 368             next;
 369         }
 370
 371         # Parse option spec.
 372         my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
 373         unless ( defined $name ) {
 374             # Failed. $orig contains the error message. Sorry for the abuse.
 375             $error .= $orig;
 376             # Kill the linkage (to avoid another error).
 377             shift (@optionlist)
 378               if @optionlist && ref($optionlist[0]);
 379             next;
 380         }
 381
 382         # If no linkage is supplied in the @optionlist, copy it from
 383         # the userlinkage if available.
 384         if ( defined $userlinkage ) {
 385             unless ( @optionlist > 0 && ref($optionlist[0]) ) {
 386                 if ( exists $userlinkage->{$orig} &&
 387                      ref($userlinkage->{$orig}) ) {
 388                     print STDERR ("=> found userlinkage for \"$orig\": ",
 389                                   "$userlinkage->{$orig}\n")
 390                         if $debug;
 391                     unshift (@optionlist, $userlinkage->{$orig});
 392                 }
 393                 else {
 394                     # Do nothing. Being undefined will be handled later.
 395                     next;
 396                 }
 397             }
 398         }
 399
 400         # Copy the linkage. If omitted, link to global variable.
 401         if ( @optionlist > 0 && ref($optionlist[0]) ) {
 402             print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
 403                 if $debug;
 404             my $rl = ref($linkage{$orig} = shift (@optionlist));
 405
 406             if ( $rl eq "ARRAY" ) {
 407                 $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
 408             }
 409             elsif ( $rl eq "HASH" ) {
 410                 $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
 411             }
 412             elsif ( $rl eq "SCALAR" || $rl eq "REF" ) {
 413 #               if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
 414 #                   my $t = $linkage{$orig};
 415 #                   $$t = $linkage{$orig} = [];
 416 #               }
 417 #               elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
 418 #               }
 419 #               else {
 420                     # Ok.
 421 #               }
 422             }
 423             elsif ( $rl eq "CODE" ) {
 424                 # Ok.
 425             }
 426             else {
 427                 $error .= "Invalid option linkage for \"$opt\"\n";
 428             }
 429         }
 430         else {
 431             # Link to global $opt_XXX variable.
 432             # Make sure a valid perl identifier results.
 433             my $ov = $orig;
 434             $ov =~ s/\W/_/g;
 435             if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
 436                 print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
 437                     if $debug;
 438                 eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
 439             }
 440             elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
 441                 print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
 442                     if $debug;
 443                 eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
 444             }
 445             else {
 446                 print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
 447                     if $debug;
 448                 eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
 449             }
 450         }
 451
 452         if ( $opctl{$name}[CTL_TYPE] eq 'I'
 453              && ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY
 454                   || $opctl{$name}[CTL_DEST] == CTL_DEST_HASH )
 455            ) {
 456             $error .= "Invalid option linkage for \"$opt\"\n";
 457         }
 458
 459     }
 460
 461     # Bail out if errors found.
 462     die ($error) if $error;
 463     $error = 0;
 464
 465     # Supply --version and --help support, if needed and allowed.
 466     if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
 467         if ( !defined($opctl{version}) ) {
 468             $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
 469             $linkage{version} = \&VersionMessage;
 470         }
 471         $auto_version = 1;
 472     }
 473     if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
 474         if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
 475             $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
 476             $linkage{help} = \&HelpMessage;
 477         }
 478         $auto_help = 1;
 479     }
 480
 481     # Show the options tables if debugging.
 482     if ( $debug ) {
 483         my ($arrow, $k, $v);
 484         $arrow = "=> ";
 485         while ( ($k,$v) = each(%opctl) ) {
 486             print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
 487             $arrow = "   ";
 488         }
 489     }
 490
 491     # Process argument list
 492     my $goon = 1;
 493     while ( $goon && @$argv > 0 ) {
 494
 495         # Get next argument.
 496         $opt = shift (@$argv);
 497         print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
 498
 499         # Double dash is option list terminator.
 500         if ( defined($opt) && $opt eq $argend ) {
 501           push (@ret, $argend) if $passthrough;
 502           last;
 503         }
 504
 505         # Look it up.
 506         my $tryopt = $opt;
 507         my $found;              # success status
 508         my $key;                # key (if hash type)
 509         my $arg;                # option argument
 510         my $ctl;                # the opctl entry
 511
 512         ($found, $opt, $ctl, $arg, $key) =
 513           FindOption ($argv, $prefix, $argend, $opt, \%opctl);
 514
 515         if ( $found ) {
 516
 517             # FindOption undefines $opt in case of errors.
 518             next unless defined $opt;
 519
 520             my $argcnt = 0;
 521             while ( defined $arg ) {
 522
 523                 # Get the canonical name.
 524                 print STDERR ("=> cname for \"$opt\" is ") if $debug;
 525                 $opt = $ctl->[CTL_CNAME];
 526                 print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
 527
 528                 if ( defined $linkage{$opt} ) {
 529                     print STDERR ("=> ref(\$L{$opt}) -> ",
 530                                   ref($linkage{$opt}), "\n") if $debug;
 531
 532                     if ( ref($linkage{$opt}) eq 'SCALAR'
 533                          || ref($linkage{$opt}) eq 'REF' ) {
 534                         if ( $ctl->[CTL_TYPE] eq '+' ) {
 535                             print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
 536                               if $debug;
 537                             if ( defined ${$linkage{$opt}} ) {
 538                                 ${$linkage{$opt}} += $arg;
 539                             }
 540                             else {
 541                                 ${$linkage{$opt}} = $arg;
 542                             }
 543                         }
 544                         elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
 545                             print STDERR ("=> ref(\$L{$opt}) auto-vivified",
 546                                           " to ARRAY\n")
 547                               if $debug;
 548                             my $t = $linkage{$opt};
 549                             $$t = $linkage{$opt} = [];
 550                             print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
 551                               if $debug;
 552                             push (@{$linkage{$opt}}, $arg);
 553                         }
 554                         elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
 555                             print STDERR ("=> ref(\$L{$opt}) auto-vivified",
 556                                           " to HASH\n")
 557                               if $debug;
 558                             my $t = $linkage{$opt};
 559                             $$t = $linkage{$opt} = {};
 560                             print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
 561                               if $debug;
 562                             $linkage{$opt}->{$key} = $arg;
 563                         }
 564                         else {
 565                             print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
 566                               if $debug;
 567                             ${$linkage{$opt}} = $arg;
 568                         }
 569                     }
 570                     elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
 571                         print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
 572                             if $debug;
 573                         push (@{$linkage{$opt}}, $arg);
 574                     }
 575                     elsif ( ref($linkage{$opt}) eq 'HASH' ) {
 576                         print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
 577                             if $debug;
 578                         $linkage{$opt}->{$key} = $arg;
 579                     }
 580                     elsif ( ref($linkage{$opt}) eq 'CODE' ) {
 581                         print STDERR ("=> &L{$opt}(\"$opt\"",
 582                                       $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
 583                                       ", \"$arg\")\n")
 584                             if $debug;
 585                         my $eval_error = do {
 586                             local $@;
 587                             local $SIG{__DIE__}  = 'DEFAULT';
 588                             eval {
 589                                 &{$linkage{$opt}}
 590                                   (Getopt::Long::CallBack->new
 591                                    (name    => $opt,
 592                                     ctl     => $ctl,
 593                                     opctl   => \%opctl,
 594                                     linkage => \%linkage,
 595                                     prefix  => $prefix,
 596                                    ),
 597                                    $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
 598                                    $arg);
 599                             };
 600                             $@;
 601                         };
 602                         print STDERR ("=> die($eval_error)\n")
 603                           if $debug && $eval_error ne '';
 604                         if ( $eval_error =~ /^!/ ) {
 605                             if ( $eval_error =~ /^!FINISH\b/ ) {
 606                                 $goon = 0;
 607                             }
 608                         }
 609                         elsif ( $eval_error ne '' ) {
 610                             warn ($eval_error);
 611                             $error++;
 612                         }
 613                     }
 614                     else {
 615                         print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
 616                                       "\" in linkage\n");
 617                         die("Getopt::Long -- internal error!\n");
 618                     }
 619                 }
 620                 # No entry in linkage means entry in userlinkage.
 621                 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
 622                     if ( defined $userlinkage->{$opt} ) {
 623                         print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
 624                             if $debug;
 625                         push (@{$userlinkage->{$opt}}, $arg);
 626                     }
 627                     else {
 628                         print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
 629                             if $debug;
 630                         $userlinkage->{$opt} = [$arg];
 631                     }
 632                 }
 633                 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
 634                     if ( defined $userlinkage->{$opt} ) {
 635                         print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
 636                             if $debug;
 637                         $userlinkage->{$opt}->{$key} = $arg;
 638                     }
 639                     else {
 640                         print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
 641                             if $debug;
 642                         $userlinkage->{$opt} = {$key => $arg};
 643                     }
 644                 }
 645                 else {
 646                     if ( $ctl->[CTL_TYPE] eq '+' ) {
 647                         print STDERR ("=> \$L{$opt} += \"$arg\"\n")
 648                           if $debug;
 649                         if ( defined $userlinkage->{$opt} ) {
 650                             $userlinkage->{$opt} += $arg;
 651                         }
 652                         else {
 653                             $userlinkage->{$opt} = $arg;
 654                         }
 655                     }
 656                     else {
 657                         print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
 658                         $userlinkage->{$opt} = $arg;
 659                     }
 660                 }
 661
 662                 $argcnt++;
 663                 last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
 664                 undef($arg);
 665
 666                 # Need more args?
 667                 if ( $argcnt < $ctl->[CTL_AMIN] ) {
 668                     if ( @$argv ) {
 669                         if ( ValidValue($ctl, $argv->[0], 1, $argend, $prefix) ) {
 670                             $arg = shift(@$argv);
 671                             if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
 672                                 $arg =~ tr/_//d;
 673                                 $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
 674                                   ? oct($arg)
 675                                   : 0+$arg
 676                             }
 677                             ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
 678                               if $ctl->[CTL_DEST] == CTL_DEST_HASH;
 679                             next;
 680                         }
 681                         warn("Value \"$$argv[0]\" invalid for option $opt\n");
 682                         $error++;
 683                     }
 684                     else {
 685                         warn("Insufficient arguments for option $opt\n");
 686                         $error++;
 687                     }
 688                 }
 689
 690                 # Any more args?
 691                 if ( @$argv && ValidValue($ctl, $argv->[0], 0, $argend, $prefix) ) {
 692                     $arg = shift(@$argv);
 693                     if ( $ctl->[CTL_TYPE] =~ /^[iIo]$/ ) {
 694                         $arg =~ tr/_//d;
 695                         $arg = $ctl->[CTL_TYPE] eq 'o' && $arg =~ /^0/
 696                           ? oct($arg)
 697                           : 0+$arg
 698                     }
 699                     ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
 700                       if $ctl->[CTL_DEST] == CTL_DEST_HASH;
 701                     next;
 702                 }
 703             }
 704         }
 705
 706         # Not an option. Save it if we $PERMUTE and don't have a <>.
 707         elsif ( $order == $PERMUTE ) {
 708             # Try non-options call-back.
 709             my $cb;
 710             if ( (defined ($cb = $linkage{'<>'})) ) {
 711                 print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
 712                   if $debug;
 713                 my $eval_error = do {
 714                     local $@;
 715                     local $SIG{__DIE__}  = 'DEFAULT';
 716                     eval {
 717                         # The arg to <> cannot be the CallBack object
 718                         # since it may be passed to other modules that
 719                         # get confused (e.g., Archive::Tar). Well,
 720                         # it's not relevant for this callback anyway.
 721                         &$cb($tryopt);
 722                     };
 723                     $@;
 724                 };
 725                 print STDERR ("=> die($eval_error)\n")
 726                   if $debug && $eval_error ne '';
 727                 if ( $eval_error =~ /^!/ ) {
 728                     if ( $eval_error =~ /^!FINISH\b/ ) {
 729                         $goon = 0;
 730                     }
 731                 }
 732                 elsif ( $eval_error ne '' ) {
 733                     warn ($eval_error);
 734                     $error++;
 735                 }
 736             }
 737             else {
 738                 print STDERR ("=> saving \"$tryopt\" ",
 739                               "(not an option, may permute)\n") if $debug;
 740                 push (@ret, $tryopt);
 741             }
 742             next;
 743         }
 744
 745         # ...otherwise, terminate.
 746         else {
 747             # Push this one back and exit.
 748             unshift (@$argv, $tryopt);
 749             return ($error == 0);
 750         }
 751
 752     }
 753
 754     # Finish.
 755     if ( @ret && $order == $PERMUTE ) {
 756         #  Push back accumulated arguments
 757         print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
 758             if $debug;
 759         unshift (@$argv, @ret);
 760     }
 761
 762     return ($error == 0);
 763 }
 764
 765 # A readable representation of what's in an optbl.
 766 sub OptCtl ($) {
 767     my ($v) = @_;
 768     my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
 769     "[".
 770       join(",",
 771            "\"$v[CTL_TYPE]\"",
 772            "\"$v[CTL_CNAME]\"",
 773            "\"$v[CTL_DEFAULT]\"",
 774            ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
 775            $v[CTL_AMIN] || '',
 776            $v[CTL_AMAX] || '',
 777 #          $v[CTL_RANGE] || '',
 778 #          $v[CTL_REPEAT] || '',
 779           ). "]";
 780 }
 781
 782 # Parse an option specification and fill the tables.
 783 sub ParseOptionSpec ($$) {
 784     my ($opt, $opctl) = @_;
 785
 786     # Match option spec.
 787     if ( $opt !~ m;^
 788                    (
 789                      # Option name
 790                      (?: \w+[-\w]* )
 791                      # Alias names, or "?"
 792                      (?: \| (?: \? | \w[-\w]* ) )*
 793                      # Aliases
 794                      (?: \| (?: [^-|!+=:][^|!+=:]* )? )*
 795                    )?
 796                    (
 797                      # Either modifiers ...
 798                      [!+]
 799                      |
 800                      # ... or a value/dest/repeat specification
 801                      [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
 802                      |
 803                      # ... or an optional-with-default spec
 804                      : (?: -?\d+ | \+ ) [@%]?
 805                    )?
 806                    $;x ) {
 807         return (undef, "Error in option spec: \"$opt\"\n");
 808     }
 809
 810     my ($names, $spec) = ($1, $2);
 811     $spec = '' unless defined $spec;
 812
 813     # $orig keeps track of the primary name the user specified.
 814     # This name will be used for the internal or external linkage.
 815     # In other words, if the user specifies "FoO|BaR", it will
 816     # match any case combinations of 'foo' and 'bar', but if a global
 817     # variable needs to be set, it will be $opt_FoO in the exact case
 818     # as specified.
 819     my $orig;
 820
 821     my @names;
 822     if ( defined $names ) {
 823         @names =  split (/\|/, $names);
 824         $orig = $names[0];
 825     }
 826     else {
 827         @names = ('');
 828         $orig = '';
 829     }
 830
 831     # Construct the opctl entries.
 832     my $entry;
 833     if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
 834         # Fields are hard-wired here.
 835         $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
 836     }
 837     elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
 838         my $def = $1;
 839         my $dest = $2;
 840         my $type = $def eq '+' ? 'I' : 'i';
 841         $dest ||= '$';
 842         $dest = $dest eq '@' ? CTL_DEST_ARRAY
 843           : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
 844         # Fields are hard-wired here.
 845         $entry = [$type,$orig,$def eq '+' ? undef : $def,
 846                   $dest,0,1];
 847     }
 848     else {
 849         my ($mand, $type, $dest) =
 850           $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
 851         return (undef, "Cannot repeat while bundling: \"$opt\"\n")
 852           if $bundling && defined($4);
 853         my ($mi, $cm, $ma) = ($5, $6, $7);
 854         return (undef, "{0} is useless in option spec: \"$opt\"\n")
 855           if defined($mi) && !$mi && !defined($ma) && !defined($cm);
 856
 857         $type = 'i' if $type eq 'n';
 858         $dest ||= '$';
 859         $dest = $dest eq '@' ? CTL_DEST_ARRAY
 860           : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
 861         # Default minargs to 1/0 depending on mand status.
 862         $mi = $mand eq '=' ? 1 : 0 unless defined $mi;
 863         # Adjust mand status according to minargs.
 864         $mand = $mi ? '=' : ':';
 865         # Adjust maxargs.
 866         $ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
 867         return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
 868           if defined($ma) && !$ma;
 869         return (undef, "Max less than min in option spec: \"$opt\"\n")
 870           if defined($ma) && $ma < $mi;
 871
 872         # Fields are hard-wired here.
 873         $entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
 874     }
 875
 876     # Process all names. First is canonical, the rest are aliases.
 877     my $dups = '';
 878     foreach ( @names ) {
 879
 880         $_ = lc ($_)
 881           if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
 882
 883         if ( exists $opctl->{$_} ) {
 884             $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
 885         }
 886
 887         if ( $spec eq '!' ) {
 888             $opctl->{"no$_"} = $entry;
 889             $opctl->{"no-$_"} = $entry;
 890             $opctl->{$_} = [@$entry];
 891             $opctl->{$_}->[CTL_TYPE] = '';
 892         }
 893         else {
 894             $opctl->{$_} = $entry;
 895         }
 896     }
 897
 898     if ( $dups && $^W ) {
 899         foreach ( split(/\n+/, $dups) ) {
 900             warn($_."\n");
 901         }
 902     }
 903     ($names[0], $orig);
 904 }
 905
 906 # Option lookup.
 907 sub FindOption ($$$$$) {
 908
 909     # returns (1, $opt, $ctl, $arg, $key) if okay,
 910     # returns (1, undef) if option in error,
 911     # returns (0) otherwise.
 912
 913     my ($argv, $prefix, $argend, $opt, $opctl) = @_;
 914
 915     print STDERR ("=> find \"$opt\"\n") if $debug;
 916
 917     return (0) unless defined($opt);
 918     return (0) unless $opt =~ /^($prefix)(.*)$/s;
 919     return (0) if $opt eq "-" && !defined $opctl->{''};
 920
 921     $opt = substr( $opt, length($1) ); # retain taintedness
 922     my $starter = $1;
 923
 924     print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
 925
 926     my $optarg;                 # value supplied with --opt=value
 927     my $rest;                   # remainder from unbundling
 928
 929     # If it is a long option, it may include the value.
 930     # With getopt_compat, only if not bundling.
 931     if ( ($starter=~/^$longprefix$/
 932           || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
 933          && (my $oppos = index($opt, '=', 1)) > 0) {
 934         my $optorg = $opt;
 935         $opt = substr($optorg, 0, $oppos);
 936         $optarg = substr($optorg, $oppos + 1); # retain tainedness
 937         print STDERR ("=> option \"", $opt,
 938                       "\", optarg = \"$optarg\"\n") if $debug;
 939     }
 940
 941     #### Look it up ###
 942
 943     my $tryopt = $opt;          # option to try
 944
 945     if ( $bundling && $starter eq '-' ) {
 946
 947         # To try overrides, obey case ignore.
 948         $tryopt = $ignorecase ? lc($opt) : $opt;
 949
 950         # If bundling == 2, long options can override bundles.
 951         if ( $bundling == 2 && length($tryopt) > 1
 952              && defined ($opctl->{$tryopt}) ) {
 953             print STDERR ("=> $starter$tryopt overrides unbundling\n")
 954               if $debug;
 955         }
 956         else {
 957             $tryopt = $opt;
 958             # Unbundle single letter option.
 959             $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
 960             $tryopt = substr ($tryopt, 0, 1);
 961             $tryopt = lc ($tryopt) if $ignorecase > 1;
 962             print STDERR ("=> $starter$tryopt unbundled from ",
 963                           "$starter$tryopt$rest\n") if $debug;
 964             $rest = undef unless $rest ne '';
 965         }
 966     }
 967
 968     # Try auto-abbreviation.
 969     elsif ( $autoabbrev && $opt ne "" ) {
 970         # Sort the possible long option names.
 971         my @names = sort(keys (%$opctl));
 972         # Downcase if allowed.
 973         $opt = lc ($opt) if $ignorecase;
 974         $tryopt = $opt;
 975         # Turn option name into pattern.
 976         my $pat = quotemeta ($opt);
 977         # Look up in option names.
 978         my @hits = grep (/^$pat/, @names);
 979         print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
 980                       "out of ", scalar(@names), "\n") if $debug;
 981
 982         # Check for ambiguous results.
 983         unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
 984             # See if all matches are for the same option.
 985             my %hit;
 986             foreach ( @hits ) {
 987                 my $hit = $opctl->{$_}->[CTL_CNAME]
 988                   if defined $opctl->{$_}->[CTL_CNAME];
 989                 $hit = "no" . $hit if $opctl->{$_}->[CTL_TYPE] eq '!';
 990                 $hit{$hit} = 1;
 991             }
 992             # Remove auto-supplied options (version, help).
 993             if ( keys(%hit) == 2 ) {
 994                 if ( $auto_version && exists($hit{version}) ) {
 995                     delete $hit{version};
 996                 }
 997                 elsif ( $auto_help && exists($hit{help}) ) {
 998                     delete $hit{help};
 999                 }
1000             }
1001             # Now see if it really is ambiguous.
1002             unless ( keys(%hit) == 1 ) {
1003                 return (0) if $passthrough;
1004                 warn ("Option ", $opt, " is ambiguous (",
1005                       join(", ", @hits), ")\n");
1006                 $error++;
1007                 return (1, undef);
1008             }
1009             @hits = keys(%hit);
1010         }
1011
1012         # Complete the option name, if appropriate.
1013         if ( @hits == 1 && $hits[0] ne $opt ) {
1014             $tryopt = $hits[0];
1015             $tryopt = lc ($tryopt) if $ignorecase;
1016             print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
1017                 if $debug;
1018         }
1019     }
1020
1021     # Map to all lowercase if ignoring case.
1022     elsif ( $ignorecase ) {
1023         $tryopt = lc ($opt);
1024     }
1025
1026     # Check validity by fetching the info.
1027     my $ctl = $opctl->{$tryopt};
1028     unless  ( defined $ctl ) {
1029         return (0) if $passthrough;
1030         # Pretend one char when bundling.
1031         if ( $bundling == 1 && length($starter) == 1 ) {
1032             $opt = substr($opt,0,1);
1033             unshift (@$argv, $starter.$rest) if defined $rest;
1034         }
1035         if ( $opt eq "" ) {
1036             warn ("Missing option after ", $starter, "\n");
1037         }
1038         else {
1039             warn ("Unknown option: ", $opt, "\n");
1040         }
1041         $error++;
1042         return (1, undef);
1043     }
1044     # Apparently valid.
1045     $opt = $tryopt;
1046     print STDERR ("=> found ", OptCtl($ctl),
1047                   " for \"", $opt, "\"\n") if $debug;
1048
1049     #### Determine argument status ####
1050
1051     # If it is an option w/o argument, we're almost finished with it.
1052     my $type = $ctl->[CTL_TYPE];
1053     my $arg;
1054
1055     if ( $type eq '' || $type eq '!' || $type eq '+' ) {
1056         if ( defined $optarg ) {
1057             return (0) if $passthrough;
1058             warn ("Option ", $opt, " does not take an argument\n");
1059             $error++;
1060             undef $opt;
1061         }
1062         elsif ( $type eq '' || $type eq '+' ) {
1063             # Supply explicit value.
1064             $arg = 1;
1065         }
1066         else {
1067             $opt =~ s/^no-?//i; # strip NO prefix
1068             $arg = 0;           # supply explicit value
1069         }
1070         unshift (@$argv, $starter.$rest) if defined $rest;
1071         return (1, $opt, $ctl, $arg);
1072     }
1073
1074     # Get mandatory status and type info.
1075     my $mand = $ctl->[CTL_AMIN];
1076
1077     # Check if there is an option argument available.
1078     if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
1079         return (1, $opt, $ctl, $type eq 's' ? '' : 0) ;#unless $mand;
1080         $optarg = 0 unless $type eq 's';
1081     }
1082
1083     # Check if there is an option argument available.
1084     if ( defined $optarg
1085          ? ($optarg eq '')
1086          : !(defined $rest || @$argv > 0) ) {
1087         # Complain if this option needs an argument.
1088 #       if ( $mand && !($type eq 's' ? defined($optarg) : 0) ) {
1089         if ( $mand ) {
1090             return (0) if $passthrough;
1091             warn ("Option ", $opt, " requires an argument\n");
1092             $error++;
1093             return (1, undef);
1094         }
1095         if ( $type eq 'I' ) {
1096             # Fake incremental type.
1097             my @c = @$ctl;
1098             $c[CTL_TYPE] = '+';
1099             return (1, $opt, \@c, 1);
1100         }
1101         return (1, $opt, $ctl,
1102                 defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1103                 $type eq 's' ? '' : 0);
1104     }
1105
1106     # Get (possibly optional) argument.
1107     $arg = (defined $rest ? $rest
1108             : (defined $optarg ? $optarg : shift (@$argv)));
1109
1110     # Get key if this is a "name=value" pair for a hash option.
1111     my $key;
1112     if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
1113         ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
1114           : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1115              ($mand ? undef : ($type eq 's' ? "" : 1)));
1116         if (! defined $arg) {
1117             warn ("Option $opt, key \"$key\", requires a value\n");
1118             $error++;
1119             # Push back.
1120             unshift (@$argv, $starter.$rest) if defined $rest;
1121             return (1, undef);
1122         }
1123     }
1124
1125     #### Check if the argument is valid for this option ####
1126
1127     my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
1128
1129     if ( $type eq 's' ) {       # string
1130         # A mandatory string takes anything.
1131         return (1, $opt, $ctl, $arg, $key) if $mand;
1132
1133         # Same for optional string as a hash value
1134         return (1, $opt, $ctl, $arg, $key)
1135           if $ctl->[CTL_DEST] == CTL_DEST_HASH;
1136
1137         # An optional string takes almost anything.
1138         return (1, $opt, $ctl, $arg, $key)
1139           if defined $optarg || defined $rest;
1140         return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
1141
1142         # Check for option or option list terminator.
1143         if ($arg eq $argend ||
1144             $arg =~ /^$prefix.+/) {
1145             # Push back.
1146             unshift (@$argv, $arg);
1147             # Supply empty value.
1148             $arg = '';
1149         }
1150     }
1151
1152     elsif ( $type eq 'i'        # numeric/integer
1153             || $type eq 'I'     # numeric/integer w/ incr default
1154             || $type eq 'o' ) { # dec/oct/hex/bin value
1155
1156         my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
1157
1158         if ( $bundling && defined $rest
1159              && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
1160             ($key, $arg, $rest) = ($1, $2, $+);
1161             chop($key) if $key;
1162             $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
1163             unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
1164         }
1165         elsif ( $arg =~ /^$o_valid$/si ) {
1166             $arg =~ tr/_//d;
1167             $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
1168         }
1169         else {
1170             if ( defined $optarg || $mand ) {
1171                 if ( $passthrough ) {
1172                     unshift (@$argv, defined $rest ? $starter.$rest : $arg)
1173                       unless defined $optarg;
1174                     return (0);
1175                 }
1176                 warn ("Value \"", $arg, "\" invalid for option ",
1177                       $opt, " (",
1178                       $type eq 'o' ? "extended " : '',
1179                       "number expected)\n");
1180                 $error++;
1181                 # Push back.
1182                 unshift (@$argv, $starter.$rest) if defined $rest;
1183                 return (1, undef);
1184             }
1185             else {
1186                 # Push back.
1187                 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
1188                 if ( $type eq 'I' ) {
1189                     # Fake incremental type.
1190                     my @c = @$ctl;
1191                     $c[CTL_TYPE] = '+';
1192                     return (1, $opt, \@c, 1);
1193                 }
1194                 # Supply default value.
1195                 $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
1196             }
1197         }
1198     }
1199
1200     elsif ( $type eq 'f' ) { # real number, int is also ok
1201         # We require at least one digit before a point or 'e',
1202         # and at least one digit following the point and 'e'.
1203         my $o_valid = PAT_FLOAT;
1204         if ( $bundling && defined $rest &&
1205              $rest =~ /^($key_valid)($o_valid)(.*)$/s ) {
1206             $arg =~ tr/_//d;
1207             ($key, $arg, $rest) = ($1, $2, $+);
1208             chop($key) if $key;
1209             unshift (@$argv, $starter.$rest) if defined $rest && $rest ne '';
1210         }
1211         elsif ( $arg =~ /^$o_valid$/ ) {
1212             $arg =~ tr/_//d;
1213         }
1214         else {
1215             if ( defined $optarg || $mand ) {
1216                 if ( $passthrough ) {
1217                     unshift (@$argv, defined $rest ? $starter.$rest : $arg)
1218                       unless defined $optarg;
1219                     return (0);
1220                 }
1221                 warn ("Value \"", $arg, "\" invalid for option ",
1222                       $opt, " (real number expected)\n");
1223                 $error++;
1224                 # Push back.
1225                 unshift (@$argv, $starter.$rest) if defined $rest;
1226                 return (1, undef);
1227             }
1228             else {
1229                 # Push back.
1230                 unshift (@$argv, defined $rest ? $starter.$rest : $arg);
1231                 # Supply default value.
1232                 $arg = 0.0;
1233             }
1234         }
1235     }
1236     else {
1237         die("Getopt::Long internal error (Can't happen)\n");
1238     }
1239     return (1, $opt, $ctl, $arg, $key);
1240 }
1241
1242 sub ValidValue ($$$$$) {
1243     my ($ctl, $arg, $mand, $argend, $prefix) = @_;
1244
1245     if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
1246         return 0 unless $arg =~ /[^=]+=(.*)/;
1247         $arg = $1;
1248     }
1249
1250     my $type = $ctl->[CTL_TYPE];
1251
1252     if ( $type eq 's' ) {       # string
1253         # A mandatory string takes anything.
1254         return (1) if $mand;
1255
1256         return (1) if $arg eq "-";
1257
1258         # Check for option or option list terminator.
1259         return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
1260         return 1;
1261     }
1262
1263     elsif ( $type eq 'i'        # numeric/integer
1264             || $type eq 'I'     # numeric/integer w/ incr default
1265             || $type eq 'o' ) { # dec/oct/hex/bin value
1266
1267         my $o_valid = $type eq 'o' ? PAT_XINT : PAT_INT;
1268         return $arg =~ /^$o_valid$/si;
1269     }
1270
1271     elsif ( $type eq 'f' ) { # real number, int is also ok
1272         # We require at least one digit before a point or 'e',
1273         # and at least one digit following the point and 'e'.
1274         # [-]NN[.NN][eNN]
1275         my $o_valid = PAT_FLOAT;
1276         return $arg =~ /^$o_valid$/;
1277     }
1278     die("ValidValue: Cannot happen\n");
1279 }
1280
1281 # Getopt::Long Configuration.
1282 sub Configure (@) {
1283     my (@options) = @_;
1284
1285     my $prevconfig =
1286       [ $error, $debug, $major_version, $minor_version,
1287         $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1288         $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1289         $longprefix ];
1290
1291     if ( ref($options[0]) eq 'ARRAY' ) {
1292         ( $error, $debug, $major_version, $minor_version,
1293           $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1294           $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1295           $longprefix ) = @{shift(@options)};
1296     }
1297
1298     my $opt;
1299     foreach $opt ( @options ) {
1300         my $try = lc ($opt);
1301         my $action = 1;
1302         if ( $try =~ /^no_?(.*)$/s ) {
1303             $action = 0;
1304             $try = $+;
1305         }
1306         if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
1307             ConfigDefaults ();
1308         }
1309         elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
1310             local $ENV{POSIXLY_CORRECT};
1311             $ENV{POSIXLY_CORRECT} = 1 if $action;
1312             ConfigDefaults ();
1313         }
1314         elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
1315             $autoabbrev = $action;
1316         }
1317         elsif ( $try eq 'getopt_compat' ) {
1318             $getopt_compat = $action;
1319             $genprefix = $action ? "(--|-|\\+)" : "(--|-)";
1320         }
1321         elsif ( $try eq 'gnu_getopt' ) {
1322             if ( $action ) {
1323                 $gnu_compat = 1;
1324                 $bundling = 1;
1325                 $getopt_compat = 0;
1326                 $genprefix = "(--|-)";
1327                 $order = $PERMUTE;
1328             }
1329         }
1330         elsif ( $try eq 'gnu_compat' ) {
1331             $gnu_compat = $action;
1332         }
1333         elsif ( $try =~ /^(auto_?)?version$/ ) {
1334             $auto_version = $action;
1335         }
1336         elsif ( $try =~ /^(auto_?)?help$/ ) {
1337             $auto_help = $action;
1338         }
1339         elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
1340             $ignorecase = $action;
1341         }
1342         elsif ( $try eq 'ignorecase_always' or $try eq 'ignore_case_always' ) {
1343             $ignorecase = $action ? 2 : 0;
1344         }
1345         elsif ( $try eq 'bundling' ) {
1346             $bundling = $action;
1347         }
1348         elsif ( $try eq 'bundling_override' ) {
1349             $bundling = $action ? 2 : 0;
1350         }
1351         elsif ( $try eq 'require_order' ) {
1352             $order = $action ? $REQUIRE_ORDER : $PERMUTE;
1353         }
1354         elsif ( $try eq 'permute' ) {
1355             $order = $action ? $PERMUTE : $REQUIRE_ORDER;
1356         }
1357         elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
1358             $passthrough = $action;
1359         }
1360         elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
1361             $genprefix = $1;
1362             # Turn into regexp. Needs to be parenthesized!
1363             $genprefix = "(" . quotemeta($genprefix) . ")";
1364             eval { '' =~ /$genprefix/; };
1365             die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
1366         }
1367         elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
1368             $genprefix = $1;
1369             # Parenthesize if needed.
1370             $genprefix = "(" . $genprefix . ")"
1371               unless $genprefix =~ /^\(.*\)$/;
1372             eval { '' =~ m"$genprefix"; };
1373             die("Getopt::Long: invalid pattern \"$genprefix\"\n") if $@;
1374         }
1375         elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
1376             $longprefix = $1;
1377             # Parenthesize if needed.
1378             $longprefix = "(" . $longprefix . ")"
1379               unless $longprefix =~ /^\(.*\)$/;
1380             eval { '' =~ m"$longprefix"; };
1381             die("Getopt::Long: invalid long prefix pattern \"$longprefix\"\n") if $@;
1382         }
1383         elsif ( $try eq 'debug' ) {
1384             $debug = $action;
1385         }
1386         else {
1387             die("Getopt::Long: unknown or erroneous config parameter \"$opt\"\n")
1388         }
1389     }
1390     $prevconfig;
1391 }
1392
1393 # Deprecated name.
1394 sub config (@) {
1395     Configure (@_);
1396 }
1397
1398 # Issue a standard message for --version.
1399 #
1400 # The arguments are mostly the same as for Pod::Usage::pod2usage:
1401 #
1402 #  - a number (exit value)
1403 #  - a string (lead in message)
1404 #  - a hash with options. See Pod::Usage for details.
1405 #
1406 sub VersionMessage(@) {
1407     # Massage args.
1408     my $pa = setup_pa_args("version", @_);
1409
1410     my $v = $main::VERSION;
1411     my $fh = $pa->{-output} ||
1412       ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
1413
1414     print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
1415                $0, defined $v ? " version $v" : (),
1416                "\n",
1417                "(", __PACKAGE__, "::", "GetOptions",
1418                " version ",
1419                defined($Getopt::Long::VERSION_STRING)
1420                  ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
1421                " Perl version ",
1422                $] >= 5.006 ? sprintf("%vd", $^V) : $],
1423                ")\n");
1424     exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
1425 }
1426
1427 # Issue a standard message for --help.
1428 #
1429 # The arguments are the same as for Pod::Usage::pod2usage:
1430 #
1431 #  - a number (exit value)
1432 #  - a string (lead in message)
1433 #  - a hash with options. See Pod::Usage for details.
1434 #
1435 sub HelpMessage(@) {
1436     eval {
1437         require Pod::Usage;
1438         import Pod::Usage;
1439         1;
1440     } || die("Cannot provide help: cannot load Pod::Usage\n");
1441
1442     # Note that pod2usage will issue a warning if -exitval => NOEXIT.
1443     pod2usage(setup_pa_args("help", @_));
1444
1445 }
1446
1447 # Helper routine to set up a normalized hash ref to be used as
1448 # argument to pod2usage.
1449 sub setup_pa_args($@) {
1450     my $tag = shift;            # who's calling
1451
1452     # If called by direct binding to an option, it will get the option
1453     # name and value as arguments. Remove these, if so.
1454     @_ = () if @_ == 2 && $_[0] eq $tag;
1455
1456     my $pa;
1457     if ( @_ > 1 ) {
1458         $pa = { @_ };
1459     }
1460     else {
1461         $pa = shift || {};
1462     }
1463
1464     # At this point, $pa can be a number (exit value), string
1465     # (message) or hash with options.
1466
1467     if ( UNIVERSAL::isa($pa, 'HASH') ) {
1468         # Get rid of -msg vs. -message ambiguity.
1469         $pa->{-message} = $pa->{-msg};
1470         delete($pa->{-msg});
1471     }
1472     elsif ( $pa =~ /^-?\d+$/ ) {
1473         $pa = { -exitval => $pa };
1474     }
1475     else {
1476         $pa = { -message => $pa };
1477     }
1478
1479     # These are _our_ defaults.
1480     $pa->{-verbose} = 0 unless exists($pa->{-verbose});
1481     $pa->{-exitval} = 0 unless exists($pa->{-exitval});
1482     $pa;
1483 }
1484
1485 # Sneak way to know what version the user requested.
1486 sub VERSION {
1487     $requested_version = $_[1];
1488     shift->SUPER::VERSION(@_);
1489 }
1490
1491 package Getopt::Long::CallBack;
1492
1493 sub new {
1494     my ($pkg, %atts) = @_;
1495     bless { %atts }, $pkg;
1496 }
1497
1498 sub name {
1499     my $self = shift;
1500     ''.$self->{name};
1501 }
1502
1503 use overload
1504   # Treat this object as an ordinary string for legacy API.
1505   '""'     => \&name,
1506   fallback => 1;
1507
1508 1;
1509
1510 ################ Documentation ################
1511
1512 =head1 NAME
1513
1514 Getopt::Long - Extended processing of command line options
1515
1516 =head1 SYNOPSIS
1517
1518   use Getopt::Long;
1519   my $data   = "file.dat";
1520   my $length = 24;
1521   my $verbose;
1522   GetOptions ("length=i" => \$length,    # numeric
1523               "file=s"   => \$data,      # string
1524               "verbose"  => \$verbose)   # flag
1525   or die("Error in command line arguments\n");
1526
1527 =head1 DESCRIPTION
1528
1529 The Getopt::Long module implements an extended getopt function called
1530 GetOptions(). It parses the command line from C<@ARGV>, recognizing
1531 and removing specified options and their possible values.
1532
1533 This function adheres to the POSIX syntax for command
1534 line options, with GNU extensions. In general, this means that options
1535 have long names instead of single letters, and are introduced with a
1536 double dash "--". Support for bundling of command line options, as was
1537 the case with the more traditional single-letter approach, is provided
1538 but not enabled by default.
1539
1540 =head1 Command Line Options, an Introduction
1541
1542 Command line operated programs traditionally take their arguments from
1543 the command line, for example filenames or other information that the
1544 program needs to know. Besides arguments, these programs often take
1545 command line I<options> as well. Options are not necessary for the
1546 program to work, hence the name 'option', but are used to modify its
1547 default behaviour. For example, a program could do its job quietly,
1548 but with a suitable option it could provide verbose information about
1549 what it did.
1550
1551 Command line options come in several flavours. Historically, they are
1552 preceded by a single dash C<->, and consist of a single letter.
1553
1554     -l -a -c
1555
1556 Usually, these single-character options can be bundled:
1557
1558     -lac
1559
1560 Options can have values, the value is placed after the option
1561 character. Sometimes with whitespace in between, sometimes not:
1562
1563     -s 24 -s24
1564
1565 Due to the very cryptic nature of these options, another style was
1566 developed that used long names. So instead of a cryptic C<-l> one
1567 could use the more descriptive C<--long>. To distinguish between a
1568 bundle of single-character options and a long one, two dashes are used
1569 to precede the option name. Early implementations of long options used
1570 a plus C<+> instead. Also, option values could be specified either
1571 like
1572
1573     --size=24
1574
1575 or
1576
1577     --size 24
1578
1579 The C<+> form is now obsolete and strongly deprecated.
1580
1581 =head1 Getting Started with Getopt::Long
1582
1583 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was the
1584 first Perl module that provided support for handling the new style of
1585 command line options, in particular long option names, hence the Perl5
1586 name Getopt::Long. This module also supports single-character options
1587 and bundling.
1588
1589 To use Getopt::Long from a Perl program, you must include the
1590 following line in your Perl program:
1591
1592     use Getopt::Long;
1593
1594 This will load the core of the Getopt::Long module and prepare your
1595 program for using it. Most of the actual Getopt::Long code is not
1596 loaded until you really call one of its functions.
1597
1598 In the default configuration, options names may be abbreviated to
1599 uniqueness, case does not matter, and a single dash is sufficient,
1600 even for long option names. Also, options may be placed between
1601 non-option arguments. See L<Configuring Getopt::Long> for more
1602 details on how to configure Getopt::Long.
1603
1604 =head2 Simple options
1605
1606 The most simple options are the ones that take no values. Their mere
1607 presence on the command line enables the option. Popular examples are:
1608
1609     --all --verbose --quiet --debug
1610
1611 Handling simple options is straightforward:
1612
1613     my $verbose = '';   # option variable with default value (false)
1614     my $all = '';       # option variable with default value (false)
1615     GetOptions ('verbose' => \$verbose, 'all' => \$all);
1616
1617 The call to GetOptions() parses the command line arguments that are
1618 present in C<@ARGV> and sets the option variable to the value C<1> if
1619 the option did occur on the command line. Otherwise, the option
1620 variable is not touched. Setting the option value to true is often
1621 called I<enabling> the option.
1622
1623 The option name as specified to the GetOptions() function is called
1624 the option I<specification>. Later we'll see that this specification
1625 can contain more than just the option name. The reference to the
1626 variable is called the option I<destination>.
1627
1628 GetOptions() will return a true value if the command line could be
1629 processed successfully. Otherwise, it will write error messages using
1630 die() and warn(), and return a false result.
1631
1632 =head2 A little bit less simple options
1633
1634 Getopt::Long supports two useful variants of simple options:
1635 I<negatable> options and I<incremental> options.
1636
1637 A negatable option is specified with an exclamation mark C<!> after the
1638 option name:
1639
1640     my $verbose = '';   # option variable with default value (false)
1641     GetOptions ('verbose!' => \$verbose);
1642
1643 Now, using C<--verbose> on the command line will enable C<$verbose>,
1644 as expected. But it is also allowed to use C<--noverbose>, which will
1645 disable C<$verbose> by setting its value to C<0>. Using a suitable
1646 default value, the program can find out whether C<$verbose> is false
1647 by default, or disabled by using C<--noverbose>.
1648
1649 An incremental option is specified with a plus C<+> after the
1650 option name:
1651
1652     my $verbose = '';   # option variable with default value (false)
1653     GetOptions ('verbose+' => \$verbose);
1654
1655 Using C<--verbose> on the command line will increment the value of
1656 C<$verbose>. This way the program can keep track of how many times the
1657 option occurred on the command line. For example, each occurrence of
1658 C<--verbose> could increase the verbosity level of the program.
1659
1660 =head2 Mixing command line option with other arguments
1661
1662 Usually programs take command line options as well as other arguments,
1663 for example, file names. It is good practice to always specify the
1664 options first, and the other arguments last. Getopt::Long will,
1665 however, allow the options and arguments to be mixed and 'filter out'
1666 all the options before passing the rest of the arguments to the
1667 program. To stop Getopt::Long from processing further arguments,
1668 insert a double dash C<--> on the command line:
1669
1670     --size 24 -- --all
1671
1672 In this example, C<--all> will I<not> be treated as an option, but
1673 passed to the program unharmed, in C<@ARGV>.
1674
1675 =head2 Options with values
1676
1677 For options that take values it must be specified whether the option
1678 value is required or not, and what kind of value the option expects.
1679
1680 Three kinds of values are supported: integer numbers, floating point
1681 numbers, and strings.
1682
1683 If the option value is required, Getopt::Long will take the
1684 command line argument that follows the option and assign this to the
1685 option variable. If, however, the option value is specified as
1686 optional, this will only be done if that value does not look like a
1687 valid command line option itself.
1688
1689     my $tag = '';       # option variable with default value
1690     GetOptions ('tag=s' => \$tag);
1691
1692 In the option specification, the option name is followed by an equals
1693 sign C<=> and the letter C<s>. The equals sign indicates that this
1694 option requires a value. The letter C<s> indicates that this value is
1695 an arbitrary string. Other possible value types are C<i> for integer
1696 values, and C<f> for floating point values. Using a colon C<:> instead
1697 of the equals sign indicates that the option value is optional. In
1698 this case, if no suitable value is supplied, string valued options get
1699 an empty string C<''> assigned, while numeric options are set to C<0>.
1700
1701 =head2 Options with multiple values
1702
1703 Options sometimes take several values. For example, a program could
1704 use multiple directories to search for library files:
1705
1706     --library lib/stdlib --library lib/extlib
1707
1708 To accomplish this behaviour, simply specify an array reference as the
1709 destination for the option:
1710
1711     GetOptions ("library=s" => \@libfiles);
1712
1713 Alternatively, you can specify that the option can have multiple
1714 values by adding a "@", and pass a scalar reference as the
1715 destination:
1716
1717     GetOptions ("library=s@" => \$libfiles);
1718
1719 Used with the example above, C<@libfiles> (or C<@$libfiles>) would
1720 contain two strings upon completion: C<"lib/stdlib"> and
1721 C<"lib/extlib">, in that order. It is also possible to specify that
1722 only integer or floating point numbers are acceptable values.
1723
1724 Often it is useful to allow comma-separated lists of values as well as
1725 multiple occurrences of the options. This is easy using Perl's split()
1726 and join() operators:
1727
1728     GetOptions ("library=s" => \@libfiles);
1729     @libfiles = split(/,/,join(',',@libfiles));
1730
1731 Of course, it is important to choose the right separator string for
1732 each purpose.
1733
1734 Warning: What follows is an experimental feature.
1735
1736 Options can take multiple values at once, for example
1737
1738     --coordinates 52.2 16.4 --rgbcolor 255 255 149
1739
1740 This can be accomplished by adding a repeat specifier to the option
1741 specification. Repeat specifiers are very similar to the C<{...}>
1742 repeat specifiers that can be used with regular expression patterns.
1743 For example, the above command line would be handled as follows:
1744
1745     GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
1746
1747 The destination for the option must be an array or array reference.
1748
1749 It is also possible to specify the minimal and maximal number of
1750 arguments an option takes. C<foo=s{2,4}> indicates an option that
1751 takes at least two and at most 4 arguments. C<foo=s{1,}> indicates one
1752 or more values; C<foo:s{,}> indicates zero or more option values.
1753
1754 =head2 Options with hash values
1755
1756 If the option destination is a reference to a hash, the option will
1757 take, as value, strings of the form I<key>C<=>I<value>. The value will
1758 be stored with the specified key in the hash.
1759
1760     GetOptions ("define=s" => \%defines);
1761
1762 Alternatively you can use:
1763
1764     GetOptions ("define=s%" => \$defines);
1765
1766 When used with command line options:
1767
1768     --define os=linux --define vendor=redhat
1769
1770 the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
1771 with value C<"linux"> and C<"vendor"> with value C<"redhat">. It is
1772 also possible to specify that only integer or floating point numbers
1773 are acceptable values. The keys are always taken to be strings.
1774
1775 =head2 User-defined subroutines to handle options
1776
1777 Ultimate control over what should be done when (actually: each time)
1778 an option is encountered on the command line can be achieved by
1779 designating a reference to a subroutine (or an anonymous subroutine)
1780 as the option destination. When GetOptions() encounters the option, it
1781 will call the subroutine with two or three arguments. The first
1782 argument is the name of the option. (Actually, it is an object that
1783 stringifies to the name of the option.) For a scalar or array destination,
1784 the second argument is the value to be stored. For a hash destination,
1785 the second argument is the key to the hash, and the third argument
1786 the value to be stored. It is up to the subroutine to store the value,
1787 or do whatever it thinks is appropriate.
1788
1789 A trivial application of this mechanism is to implement options that
1790 are related to each other. For example:
1791
1792     my $verbose = '';   # option variable with default value (false)
1793     GetOptions ('verbose' => \$verbose,
1794                 'quiet'   => sub { $verbose = 0 });
1795
1796 Here C<--verbose> and C<--quiet> control the same variable
1797 C<$verbose>, but with opposite values.
1798
1799 If the subroutine needs to signal an error, it should call die() with
1800 the desired error message as its argument. GetOptions() will catch the
1801 die(), issue the error message, and record that an error result must
1802 be returned upon completion.
1803
1804 If the text of the error message starts with an exclamation mark C<!>
1805 it is interpreted specially by GetOptions(). There is currently one
1806 special command implemented: C<die("!FINISH")> will cause GetOptions()
1807 to stop processing options, as if it encountered a double dash C<-->.
1808
1809 In version 2.37 the first argument to the callback function was
1810 changed from string to object. This was done to make room for
1811 extensions and more detailed control. The object stringifies to the
1812 option name so this change should not introduce compatibility
1813 problems.
1814
1815 Here is an example of how to access the option name and value from within
1816 a subroutine:
1817
1818     GetOptions ('opt=i' => \&handler);
1819     sub handler {
1820         my ($opt_name, $opt_value) = @_;
1821         print("Option name is $opt_name and value is $opt_value\n");
1822     }
1823
1824 =head2 Options with multiple names
1825
1826 Often it is user friendly to supply alternate mnemonic names for
1827 options. For example C<--height> could be an alternate name for
1828 C<--length>. Alternate names can be included in the option
1829 specification, separated by vertical bar C<|> characters. To implement
1830 the above example:
1831
1832     GetOptions ('length|height=f' => \$length);
1833
1834 The first name is called the I<primary> name, the other names are
1835 called I<aliases>. When using a hash to store options, the key will
1836 always be the primary name.
1837
1838 Multiple alternate names are possible.
1839
1840 =head2 Case and abbreviations
1841
1842 Without additional configuration, GetOptions() will ignore the case of
1843 option names, and allow the options to be abbreviated to uniqueness.
1844
1845     GetOptions ('length|height=f' => \$length, "head" => \$head);
1846
1847 This call will allow C<--l> and C<--L> for the length option, but
1848 requires a least C<--hea> and C<--hei> for the head and height options.
1849
1850 =head2 Summary of Option Specifications
1851
1852 Each option specifier consists of two parts: the name specification
1853 and the argument specification.
1854
1855 The name specification contains the name of the option, optionally
1856 followed by a list of alternative names separated by vertical bar
1857 characters.
1858
1859     length            option name is "length"
1860     length|size|l     name is "length", aliases are "size" and "l"
1861
1862 The argument specification is optional. If omitted, the option is
1863 considered boolean, a value of 1 will be assigned when the option is
1864 used on the command line.
1865
1866 The argument specification can be
1867
1868 =over 4
1869
1870 =item !
1871
1872 The option does not take an argument and may be negated by prefixing
1873 it with "no" or "no-". E.g. C<"foo!"> will allow C<--foo> (a value of
1874 1 will be assigned) as well as C<--nofoo> and C<--no-foo> (a value of
1875 0 will be assigned). If the option has aliases, this applies to the
1876 aliases as well.
1877
1878 Using negation on a single letter option when bundling is in effect is
1879 pointless and will result in a warning.
1880
1881 =item +
1882
1883 The option does not take an argument and will be incremented by 1
1884 every time it appears on the command line. E.g. C<"more+">, when used
1885 with C<--more --more --more>, will increment the value three times,
1886 resulting in a value of 3 (provided it was 0 or undefined at first).
1887
1888 The C<+> specifier is ignored if the option destination is not a scalar.
1889
1890 =item = I<type> [ I<desttype> ] [ I<repeat> ]
1891
1892 The option requires an argument of the given type. Supported types
1893 are:
1894
1895 =over 4
1896
1897 =item s
1898
1899 String. An arbitrary sequence of characters. It is valid for the
1900 argument to start with C<-> or C<-->.
1901
1902 =item i
1903
1904 Integer. An optional leading plus or minus sign, followed by a
1905 sequence of digits.
1906
1907 =item o
1908
1909 Extended integer, Perl style. This can be either an optional leading
1910 plus or minus sign, followed by a sequence of digits, or an octal
1911 string (a zero, optionally followed by '0', '1', .. '7'), or a
1912 hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
1913 insensitive), or a binary string (C<0b> followed by a series of '0'
1914 and '1').
1915
1916 =item f
1917
1918 Real number. For example C<3.14>, C<-6.23E24> and so on.
1919
1920 =back
1921
1922 The I<desttype> can be C<@> or C<%> to specify that the option is
1923 list or a hash valued. This is only needed when the destination for
1924 the option value is not otherwise specified. It should be omitted when
1925 not needed.
1926
1927 The I<repeat> specifies the number of values this option takes per
1928 occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
1929
1930 I<min> denotes the minimal number of arguments. It defaults to 1 for
1931 options with C<=> and to 0 for options with C<:>, see below. Note that
1932 I<min> overrules the C<=> / C<:> semantics.
1933
1934 I<max> denotes the maximum number of arguments. It must be at least
1935 I<min>. If I<max> is omitted, I<but the comma is not>, there is no
1936 upper bound to the number of argument values taken.
1937
1938 =item : I<type> [ I<desttype> ]
1939
1940 Like C<=>, but designates the argument as optional.
1941 If omitted, an empty string will be assigned to string values options,
1942 and the value zero to numeric options.
1943
1944 Note that if a string argument starts with C<-> or C<-->, it will be
1945 considered an option on itself.
1946
1947 =item : I<number> [ I<desttype> ]
1948
1949 Like C<:i>, but if the value is omitted, the I<number> will be assigned.
1950
1951 =item : + [ I<desttype> ]
1952
1953 Like C<:i>, but if the value is omitted, the current value for the
1954 option will be incremented.
1955
1956 =back
1957
1958 =head1 Advanced Possibilities
1959
1960 =head2 Object oriented interface
1961
1962 Getopt::Long can be used in an object oriented way as well:
1963
1964     use Getopt::Long;
1965     $p = Getopt::Long::Parser->new;
1966     $p->configure(...configuration options...);
1967     if ($p->getoptions(...options descriptions...)) ...
1968     if ($p->getoptionsfromarray( \@array, ...options descriptions...)) ...
1969
1970 Configuration options can be passed to the constructor:
1971
1972     $p = new Getopt::Long::Parser
1973              config => [...configuration options...];
1974
1975 =head2 Thread Safety
1976
1977 Getopt::Long is thread safe when using ithreads as of Perl 5.8.  It is
1978 I<not> thread safe when using the older (experimental and now
1979 obsolete) threads implementation that was added to Perl 5.005.
1980
1981 =head2 Documentation and help texts
1982
1983 Getopt::Long encourages the use of Pod::Usage to produce help
1984 messages. For example:
1985
1986     use Getopt::Long;
1987     use Pod::Usage;
1988
1989     my $man = 0;
1990     my $help = 0;
1991
1992     GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1993     pod2usage(1) if $help;
1994     pod2usage(-exitval => 0, -verbose => 2) if $man;
1995
1996     __END__
1997
1998     =head1 NAME
1999
2000     sample - Using Getopt::Long and Pod::Usage
2001
2002     =head1 SYNOPSIS
2003
2004     sample [options] [file ...]
2005
2006      Options:
2007        -help            brief help message
2008        -man             full documentation
2009
2010     =head1 OPTIONS
2011
2012     =over 8
2013
2014     =item B<-help>
2015
2016     Print a brief help message and exits.
2017
2018     =item B<-man>
2019
2020     Prints the manual page and exits.
2021
2022     =back
2023
2024     =head1 DESCRIPTION
2025
2026     B<This program> will read the given input file(s) and do something
2027     useful with the contents thereof.
2028
2029     =cut
2030
2031 See L<Pod::Usage> for details.
2032
2033 =head2 Parsing options from an arbitrary array
2034
2035 By default, GetOptions parses the options that are present in the
2036 global array C<@ARGV>. A special entry C<GetOptionsFromArray> can be
2037 used to parse options from an arbitrary array.
2038
2039     use Getopt::Long qw(GetOptionsFromArray);
2040     $ret = GetOptionsFromArray(\@myopts, ...);
2041
2042 When used like this, options and their possible values are removed
2043 from C<@myopts>, the global C<@ARGV> is not touched at all.
2044
2045 The following two calls behave identically:
2046
2047     $ret = GetOptions( ... );
2048     $ret = GetOptionsFromArray(\@ARGV, ... );
2049
2050 This also means that a first argument hash reference now becomes the
2051 second argument:
2052
2053     $ret = GetOptions(\%opts, ... );
2054     $ret = GetOptionsFromArray(\@ARGV, \%opts, ... );
2055
2056 =head2 Parsing options from an arbitrary string
2057
2058 A special entry C<GetOptionsFromString> can be used to parse options
2059 from an arbitrary string.
2060
2061     use Getopt::Long qw(GetOptionsFromString);
2062     $ret = GetOptionsFromString($string, ...);
2063
2064 The contents of the string are split into arguments using a call to
2065 C<Text::ParseWords::shellwords>. As with C<GetOptionsFromArray>, the
2066 global C<@ARGV> is not touched.
2067
2068 It is possible that, upon completion, not all arguments in the string
2069 have been processed. C<GetOptionsFromString> will, when called in list
2070 context, return both the return status and an array reference to any
2071 remaining arguments:
2072
2073     ($ret, $args) = GetOptionsFromString($string, ... );
2074
2075 If any arguments remain, and C<GetOptionsFromString> was not called in
2076 list context, a message will be given and C<GetOptionsFromString> will
2077 return failure.
2078
2079 As with GetOptionsFromArray, a first argument hash reference now
2080 becomes the second argument.
2081
2082 =head2 Storing options values in a hash
2083
2084 Sometimes, for example when there are a lot of options, having a
2085 separate variable for each of them can be cumbersome. GetOptions()
2086 supports, as an alternative mechanism, storing options values in a
2087 hash.
2088
2089 To obtain this, a reference to a hash must be passed I<as the first
2090 argument> to GetOptions(). For each option that is specified on the
2091 command line, the option value will be stored in the hash with the
2092 option name as key. Options that are not actually used on the command
2093 line will not be put in the hash, on other words,
2094 C<exists($h{option})> (or defined()) can be used to test if an option
2095 was used. The drawback is that warnings will be issued if the program
2096 runs under C<use strict> and uses C<$h{option}> without testing with
2097 exists() or defined() first.
2098
2099     my %h = ();
2100     GetOptions (\%h, 'length=i');       # will store in $h{length}
2101
2102 For options that take list or hash values, it is necessary to indicate
2103 this by appending an C<@> or C<%> sign after the type:
2104
2105     GetOptions (\%h, 'colours=s@');     # will push to @{$h{colours}}
2106
2107 To make things more complicated, the hash may contain references to
2108 the actual destinations, for example:
2109
2110     my $len = 0;
2111     my %h = ('length' => \$len);
2112     GetOptions (\%h, 'length=i');       # will store in $len
2113
2114 This example is fully equivalent with:
2115
2116     my $len = 0;
2117     GetOptions ('length=i' => \$len);   # will store in $len
2118
2119 Any mixture is possible. For example, the most frequently used options
2120 could be stored in variables while all other options get stored in the
2121 hash:
2122
2123     my $verbose = 0;                    # frequently referred
2124     my $debug = 0;                      # frequently referred
2125     my %h = ('verbose' => \$verbose, 'debug' => \$debug);
2126     GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
2127     if ( $verbose ) { ... }
2128     if ( exists $h{filter} ) { ... option 'filter' was specified ... }
2129
2130 =head2 Bundling
2131
2132 With bundling it is possible to set several single-character options
2133 at once. For example if C<a>, C<v> and C<x> are all valid options,
2134
2135     -vax
2136
2137 would set all three.
2138
2139 Getopt::Long supports two levels of bundling. To enable bundling, a
2140 call to Getopt::Long::Configure is required.
2141
2142 The first level of bundling can be enabled with:
2143
2144     Getopt::Long::Configure ("bundling");
2145
2146 Configured this way, single-character options can be bundled but long
2147 options B<must> always start with a double dash C<--> to avoid
2148 ambiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
2149 options,
2150
2151     -vax
2152
2153 would set C<a>, C<v> and C<x>, but
2154
2155     --vax
2156
2157 would set C<vax>.
2158
2159 The second level of bundling lifts this restriction. It can be enabled
2160 with:
2161
2162     Getopt::Long::Configure ("bundling_override");
2163
2164 Now, C<-vax> would set the option C<vax>.
2165
2166 When any level of bundling is enabled, option values may be inserted
2167 in the bundle. For example:
2168
2169     -h24w80
2170
2171 is equivalent to
2172
2173     -h 24 -w 80
2174
2175 When configured for bundling, single-character options are matched
2176 case sensitive while long options are matched case insensitive. To
2177 have the single-character options matched case insensitive as well,
2178 use:
2179
2180     Getopt::Long::Configure ("bundling", "ignorecase_always");
2181
2182 It goes without saying that bundling can be quite confusing.
2183
2184 =head2 The lonesome dash
2185
2186 Normally, a lone dash C<-> on the command line will not be considered
2187 an option. Option processing will terminate (unless "permute" is
2188 configured) and the dash will be left in C<@ARGV>.
2189
2190 It is possible to get special treatment for a lone dash. This can be
2191 achieved by adding an option specification with an empty name, for
2192 example:
2193
2194     GetOptions ('' => \$stdio);
2195
2196 A lone dash on the command line will now be a legal option, and using
2197 it will set variable C<$stdio>.
2198
2199 =head2 Argument callback
2200
2201 A special option 'name' C<< <> >> can be used to designate a subroutine
2202 to handle non-option arguments. When GetOptions() encounters an
2203 argument that does not look like an option, it will immediately call this
2204 subroutine and passes it one parameter: the argument name. Well, actually
2205 it is an object that stringifies to the argument name.
2206
2207 For example:
2208
2209     my $width = 80;
2210     sub process { ... }
2211     GetOptions ('width=i' => \$width, '<>' => \&process);
2212
2213 When applied to the following command line:
2214
2215     arg1 --width=72 arg2 --width=60 arg3
2216
2217 This will call
2218 C<process("arg1")> while C<$width> is C<80>,
2219 C<process("arg2")> while C<$width> is C<72>, and
2220 C<process("arg3")> while C<$width> is C<60>.
2221
2222 This feature requires configuration option B<permute>, see section
2223 L<Configuring Getopt::Long>.
2224
2225 =head1 Configuring Getopt::Long
2226
2227 Getopt::Long can be configured by calling subroutine
2228 Getopt::Long::Configure(). This subroutine takes a list of quoted
2229 strings, each specifying a configuration option to be enabled, e.g.
2230 C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
2231 matter. Multiple calls to Configure() are possible.
2232
2233 Alternatively, as of version 2.24, the configuration options may be
2234 passed together with the C<use> statement:
2235
2236     use Getopt::Long qw(:config no_ignore_case bundling);
2237
2238 The following options are available:
2239
2240 =over 12
2241
2242 =item default
2243
2244 This option causes all configuration options to be reset to their
2245 default values.
2246
2247 =item posix_default
2248
2249 This option causes all configuration options to be reset to their
2250 default values as if the environment variable POSIXLY_CORRECT had
2251 been set.
2252
2253 =item auto_abbrev
2254
2255 Allow option names to be abbreviated to uniqueness.
2256 Default is enabled unless environment variable
2257 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
2258
2259 =item getopt_compat
2260
2261 Allow C<+> to start options.
2262 Default is enabled unless environment variable
2263 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
2264
2265 =item gnu_compat
2266
2267 C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
2268 do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
2269 C<--opt=> will give option C<opt> and empty value.
2270 This is the way GNU getopt_long() does it.
2271
2272 =item gnu_getopt
2273
2274 This is a short way of setting C<gnu_compat> C<bundling> C<permute>
2275 C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
2276 fully compatible with GNU getopt_long().
2277
2278 =item require_order
2279
2280 Whether command line arguments are allowed to be mixed with options.
2281 Default is disabled unless environment variable
2282 POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
2283
2284 See also C<permute>, which is the opposite of C<require_order>.
2285
2286 =item permute
2287
2288 Whether command line arguments are allowed to be mixed with options.
2289 Default is enabled unless environment variable
2290 POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
2291 Note that C<permute> is the opposite of C<require_order>.
2292
2293 If C<permute> is enabled, this means that
2294
2295     --foo arg1 --bar arg2 arg3
2296
2297 is equivalent to
2298
2299     --foo --bar arg1 arg2 arg3
2300
2301 If an argument callback routine is specified, C<@ARGV> will always be
2302 empty upon successful return of GetOptions() since all options have been
2303 processed. The only exception is when C<--> is used:
2304
2305     --foo arg1 --bar arg2 -- arg3
2306
2307 This will call the callback routine for arg1 and arg2, and then
2308 terminate GetOptions() leaving C<"arg3"> in C<@ARGV>.
2309
2310 If C<require_order> is enabled, options processing
2311 terminates when the first non-option is encountered.
2312
2313     --foo arg1 --bar arg2 arg3
2314
2315 is equivalent to
2316
2317     --foo -- arg1 --bar arg2 arg3
2318
2319 If C<pass_through> is also enabled, options processing will terminate
2320 at the first unrecognized option, or non-option, whichever comes
2321 first.
2322
2323 =item bundling (default: disabled)
2324
2325 Enabling this option will allow single-character options to be
2326 bundled. To distinguish bundles from long option names, long options
2327 I<must> be introduced with C<--> and bundles with C<->.
2328
2329 Note that, if you have options C<a>, C<l> and C<all>, and
2330 auto_abbrev enabled, possible arguments and option settings are:
2331
2332     using argument               sets option(s)
2333     ------------------------------------------
2334     -a, --a                      a
2335     -l, --l                      l
2336     -al, -la, -ala, -all,...     a, l
2337     --al, --all                  all
2338
2339 The surprising part is that C<--a> sets option C<a> (due to auto
2340 completion), not C<all>.
2341
2342 Note: disabling C<bundling> also disables C<bundling_override>.
2343
2344 =item bundling_override (default: disabled)
2345
2346 If C<bundling_override> is enabled, bundling is enabled as with
2347 C<bundling> but now long option names override option bundles.
2348
2349 Note: disabling C<bundling_override> also disables C<bundling>.
2350
2351 B<Note:> Using option bundling can easily lead to unexpected results,
2352 especially when mixing long options and bundles. Caveat emptor.
2353
2354 =item ignore_case  (default: enabled)
2355
2356 If enabled, case is ignored when matching option names. If, however,
2357 bundling is enabled as well, single character options will be treated
2358 case-sensitive.
2359
2360 With C<ignore_case>, option specifications for options that only
2361 differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
2362 duplicates.
2363
2364 Note: disabling C<ignore_case> also disables C<ignore_case_always>.
2365
2366 =item ignore_case_always (default: disabled)
2367
2368 When bundling is in effect, case is ignored on single-character
2369 options also.
2370
2371 Note: disabling C<ignore_case_always> also disables C<ignore_case>.
2372
2373 =item auto_version (default:disabled)
2374
2375 Automatically provide support for the B<--version> option if
2376 the application did not specify a handler for this option itself.
2377
2378 Getopt::Long will provide a standard version message that includes the
2379 program name, its version (if $main::VERSION is defined), and the
2380 versions of Getopt::Long and Perl. The message will be written to
2381 standard output and processing will terminate.
2382
2383 C<auto_version> will be enabled if the calling program explicitly
2384 specified a version number higher than 2.32 in the C<use> or
2385 C<require> statement.
2386
2387 =item auto_help (default:disabled)
2388
2389 Automatically provide support for the B<--help> and B<-?> options if
2390 the application did not specify a handler for this option itself.
2391
2392 Getopt::Long will provide a help message using module L<Pod::Usage>. The
2393 message, derived from the SYNOPSIS POD section, will be written to
2394 standard output and processing will terminate.
2395
2396 C<auto_help> will be enabled if the calling program explicitly
2397 specified a version number higher than 2.32 in the C<use> or
2398 C<require> statement.
2399
2400 =item pass_through (default: disabled)
2401
2402 Options that are unknown, ambiguous or supplied with an invalid option
2403 value are passed through in C<@ARGV> instead of being flagged as
2404 errors. This makes it possible to write wrapper scripts that process
2405 only part of the user supplied command line arguments, and pass the
2406 remaining options to some other program.
2407
2408 If C<require_order> is enabled, options processing will terminate at
2409 the first unrecognized option, or non-option, whichever comes first.
2410 However, if C<permute> is enabled instead, results can become confusing.
2411
2412 Note that the options terminator (default C<-->), if present, will
2413 also be passed through in C<@ARGV>.
2414
2415 =item prefix
2416
2417 The string that starts options. If a constant string is not
2418 sufficient, see C<prefix_pattern>.
2419
2420 =item prefix_pattern
2421
2422 A Perl pattern that identifies the strings that introduce options.
2423 Default is C<--|-|\+> unless environment variable
2424 POSIXLY_CORRECT has been set, in which case it is C<--|->.
2425
2426 =item long_prefix_pattern
2427
2428 A Perl pattern that allows the disambiguation of long and short
2429 prefixes. Default is C<-->.
2430
2431 Typically you only need to set this if you are using nonstandard
2432 prefixes and want some or all of them to have the same semantics as
2433 '--' does under normal circumstances.
2434
2435 For example, setting prefix_pattern to C<--|-|\+|\/> and
2436 long_prefix_pattern to C<--|\/> would add Win32 style argument
2437 handling.
2438
2439 =item debug (default: disabled)
2440
2441 Enable debugging output.
2442
2443 =back
2444
2445 =head1 Exportable Methods
2446
2447 =over
2448
2449 =item VersionMessage
2450
2451 This subroutine provides a standard version message. Its argument can be:
2452
2453 =over 4
2454
2455 =item *
2456
2457 A string containing the text of a message to print I<before> printing
2458 the standard message.
2459
2460 =item *
2461
2462 A numeric value corresponding to the desired exit status.
2463
2464 =item *
2465
2466 A reference to a hash.
2467
2468 =back
2469
2470 If more than one argument is given then the entire argument list is
2471 assumed to be a hash.  If a hash is supplied (either as a reference or
2472 as a list) it should contain one or more elements with the following
2473 keys:
2474
2475 =over 4
2476
2477 =item C<-message>
2478
2479 =item C<-msg>
2480
2481 The text of a message to print immediately prior to printing the
2482 program's usage message.
2483
2484 =item C<-exitval>
2485
2486 The desired exit status to pass to the B<exit()> function.
2487 This should be an integer, or else the string "NOEXIT" to
2488 indicate that control should simply be returned without
2489 terminating the invoking process.
2490
2491 =item C<-output>
2492
2493 A reference to a filehandle, or the pathname of a file to which the
2494 usage message should be written. The default is C<\*STDERR> unless the
2495 exit value is less than 2 (in which case the default is C<\*STDOUT>).
2496
2497 =back
2498
2499 You cannot tie this routine directly to an option, e.g.:
2500
2501     GetOptions("version" => \&VersionMessage);
2502
2503 Use this instead:
2504
2505     GetOptions("version" => sub { VersionMessage() });
2506
2507 =item HelpMessage
2508
2509 This subroutine produces a standard help message, derived from the
2510 program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
2511 arguments as VersionMessage(). In particular, you cannot tie it
2512 directly to an option, e.g.:
2513
2514     GetOptions("help" => \&HelpMessage);
2515
2516 Use this instead:
2517
2518     GetOptions("help" => sub { HelpMessage() });
2519
2520 =back
2521
2522 =head1 Return values and Errors
2523
2524 Configuration errors and errors in the option definitions are
2525 signalled using die() and will terminate the calling program unless
2526 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
2527 }>, or die() was trapped using C<$SIG{__DIE__}>.
2528
2529 GetOptions returns true to indicate success.
2530 It returns false when the function detected one or more errors during
2531 option parsing. These errors are signalled using warn() and can be
2532 trapped with C<$SIG{__WARN__}>.
2533
2534 =head1 Legacy
2535
2536 The earliest development of C<newgetopt.pl> started in 1990, with Perl
2537 version 4. As a result, its development, and the development of
2538 Getopt::Long, has gone through several stages. Since backward
2539 compatibility has always been extremely important, the current version
2540 of Getopt::Long still supports a lot of constructs that nowadays are
2541 no longer necessary or otherwise unwanted. This section describes
2542 briefly some of these 'features'.
2543
2544 =head2 Default destinations
2545
2546 When no destination is specified for an option, GetOptions will store
2547 the resultant value in a global variable named C<opt_>I<XXX>, where
2548 I<XXX> is the primary name of this option. When a program executes
2549 under C<use strict> (recommended), these variables must be
2550 pre-declared with our() or C<use vars>.
2551
2552     our $opt_length = 0;
2553     GetOptions ('length=i');    # will store in $opt_length
2554
2555 To yield a usable Perl variable, characters that are not part of the
2556 syntax for variables are translated to underscores. For example,
2557 C<--fpp-struct-return> will set the variable
2558 C<$opt_fpp_struct_return>. Note that this variable resides in the
2559 namespace of the calling program, not necessarily C<main>. For
2560 example:
2561
2562     GetOptions ("size=i", "sizes=i@");
2563
2564 with command line "-size 10 -sizes 24 -sizes 48" will perform the
2565 equivalent of the assignments
2566
2567     $opt_size = 10;
2568     @opt_sizes = (24, 48);
2569
2570 =head2 Alternative option starters
2571
2572 A string of alternative option starter characters may be passed as the
2573 first argument (or the first argument after a leading hash reference
2574 argument).
2575
2576     my $len = 0;
2577     GetOptions ('/', 'length=i' => $len);
2578
2579 Now the command line may look like:
2580
2581     /length 24 -- arg
2582
2583 Note that to terminate options processing still requires a double dash
2584 C<-->.
2585
2586 GetOptions() will not interpret a leading C<< "<>" >> as option starters
2587 if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
2588 option starters, use C<< "><" >>. Confusing? Well, B<using a starter
2589 argument is strongly deprecated> anyway.
2590
2591 =head2 Configuration variables
2592
2593 Previous versions of Getopt::Long used variables for the purpose of
2594 configuring. Although manipulating these variables still work, it is
2595 strongly encouraged to use the C<Configure> routine that was introduced
2596 in version 2.17. Besides, it is much easier.
2597
2598 =head1 Tips and Techniques
2599
2600 =head2 Pushing multiple values in a hash option
2601
2602 Sometimes you want to combine the best of hashes and arrays. For
2603 example, the command line:
2604
2605   --list add=first --list add=second --list add=third
2606
2607 where each successive 'list add' option will push the value of add
2608 into array ref $list->{'add'}. The result would be like
2609
2610   $list->{add} = [qw(first second third)];
2611
2612 This can be accomplished with a destination routine:
2613
2614   GetOptions('list=s%' =>
2615                sub { push(@{$list{$_[1]}}, $_[2]) });
2616
2617 =head1 Troubleshooting
2618
2619 =head2 GetOptions does not return a false result when an option is not supplied
2620
2621 That's why they're called 'options'.
2622
2623 =head2 GetOptions does not split the command line correctly
2624
2625 The command line is not split by GetOptions, but by the command line
2626 interpreter (CLI). On Unix, this is the shell. On Windows, it is
2627 COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
2628
2629 It is important to know that these CLIs may behave different when the
2630 command line contains special characters, in particular quotes or
2631 backslashes. For example, with Unix shells you can use single quotes
2632 (C<'>) and double quotes (C<">) to group words together. The following
2633 alternatives are equivalent on Unix:
2634
2635     "two words"
2636     'two words'
2637     two\ words
2638
2639 In case of doubt, insert the following statement in front of your Perl
2640 program:
2641
2642     print STDERR (join("|",@ARGV),"\n");
2643
2644 to verify how your CLI passes the arguments to the program.
2645
2646 =head2 Undefined subroutine &main::GetOptions called
2647
2648 Are you running Windows, and did you write
2649
2650     use GetOpt::Long;
2651
2652 (note the capital 'O')?
2653
2654 =head2 How do I put a "-?" option into a Getopt::Long?
2655
2656 You can only obtain this using an alias, and Getopt::Long of at least
2657 version 2.13.
2658
2659     use Getopt::Long;
2660     GetOptions ("help|?");    # -help and -? will both set $opt_help
2661
2662 Other characters that can't appear in Perl identifiers are also supported
2663 as aliases with Getopt::Long of at least version 2.39.
2664
2665 As of version 2.32 Getopt::Long provides auto-help, a quick and easy way
2666 to add the options --help and -? to your program, and handle them.
2667
2668 See C<auto_help> in section L<Configuring Getopt::Long>.
2669
2670 =head1 AUTHOR
2671
2672 Johan Vromans <jvromans@squirrel.nl>
2673
2674 =head1 COPYRIGHT AND DISCLAIMER
2675
2676 This program is Copyright 1990,2013 by Johan Vromans.
2677 This program is free software; you can redistribute it and/or
2678 modify it under the terms of the Perl Artistic License or the
2679 GNU General Public License as published by the Free Software
2680 Foundation; either version 2 of the License, or (at your option) any
2681 later version.
2682
2683 This program is distributed in the hope that it will be useful,
2684 but WITHOUT ANY WARRANTY; without even the implied warranty of
2685 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
2686 GNU General Public License for more details.
2687
2688 If you do not have a copy of the GNU General Public License write to
2689 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
2690 MA 02139, USA.
2691
2692 =cut
2693