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