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