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