1 # Getopt::Long.pm -- Universal options parsing
5 # RCS Status : $Id: GetoptLong.pm,v 2.72 2005-04-28 21:18:33+02 jv Exp $
6 # Author : Johan Vromans
7 # Created On : Tue Sep 11 15:00:12 1990
8 # Last Modified By: Johan Vromans
9 # Last Modified On: Thu Apr 28 21:14:19 2005
13 ################ Copyright ################
15 # This program is Copyright 1990,2005 by Johan Vromans.
16 # This program is free software; you can redistribute it and/or
17 # modify it under the terms of the Perl Artistic License or the
18 # GNU General Public License as published by the Free Software
19 # Foundation; either version 2 of the License, or (at your option) any
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.
27 # If you do not have a copy of the GNU General Public License write to
28 # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,
31 ################ Module Preamble ################
37 use vars qw($VERSION);
39 # For testing versions only.
40 use vars qw($VERSION_STRING);
41 $VERSION_STRING = "2.34_04";
44 use vars qw(@ISA @EXPORT @EXPORT_OK);
47 # Exported subroutines.
48 sub GetOptions(@); # always
49 sub Configure(@); # on demand
50 sub HelpMessage(@); # on demand
51 sub VersionMessage(@); # in demand
54 # Init immediately so their contents can be used in the 'use vars' below.
55 @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER);
56 @EXPORT_OK = qw(&HelpMessage &VersionMessage &Configure);
59 # User visible variables.
60 use vars @EXPORT, @EXPORT_OK;
61 use vars qw($error $debug $major_version $minor_version);
62 # Deprecated visible variables.
63 use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order
65 # Official invisible variables.
66 use vars qw($genprefix $caller $gnu_compat $auto_help $auto_version $longprefix);
69 sub config(@); # deprecated name
71 # Private subroutines.
73 sub ParseOptionSpec($$);
76 sub ValidValue ($$$$$);
78 ################ Local Variables ################
80 # $requested_version holds the version that was mentioned in the 'use'
81 # or 'require', if any. It can be used to enable or disable specific
83 my $requested_version = 0;
85 ################ Resident subroutines ################
87 sub ConfigDefaults() {
88 # Handle POSIX compliancy.
89 if ( defined $ENV{"POSIXLY_CORRECT"} ) {
90 $genprefix = "(--|-)";
91 $autoabbrev = 0; # no automatic abbrev of options
92 $bundling = 0; # no bundling of single letter switches
93 $getopt_compat = 0; # disallow '+' to start options
94 $order = $REQUIRE_ORDER;
97 $genprefix = "(--|-|\\+)";
98 $autoabbrev = 1; # automatic abbrev of options
99 $bundling = 0; # bundling off by default
100 $getopt_compat = 1; # allow '+' to start options
103 # Other configurable settings.
104 $debug = 0; # for debugging
105 $error = 0; # error tally
106 $ignorecase = 1; # ignore case when matching options
107 $passthrough = 0; # leave unrecognized options alone
108 $gnu_compat = 0; # require --opt=val if value is optional
109 $longprefix = "(--)"; # what does a long prefix look like
114 my $pkg = shift; # package
115 my @syms = (); # symbols to import
116 my @config = (); # configuration
117 my $dest = \@syms; # symbols first
119 if ( $_ eq ':config' ) {
120 $dest = \@config; # config next
123 push(@$dest, $_); # push
125 # Hide one level and call super.
126 local $Exporter::ExportLevel = 1;
127 push(@syms, qw(&GetOptions)) if @syms; # always export GetOptions
128 $pkg->SUPER::import(@syms);
130 Configure(@config) if @config;
133 ################ Initialization ################
135 # Values for $order. See GNU getopt.c for details.
136 ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2);
137 # Version major/minor numbers.
138 ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/;
142 ################ OO Interface ################
144 package Getopt::Long::Parser;
146 # Store a copy of the default configuration. Since ConfigDefaults has
147 # just been called, what we get from Configure is the default.
148 my $default_config = do {
149 Getopt::Long::Configure ()
154 my $class = ref($that) || $that;
157 # Register the callers package.
158 my $self = { caller_pkg => (caller)[0] };
160 bless ($self, $class);
162 # Process config attributes.
163 if ( defined $atts{config} ) {
164 my $save = Getopt::Long::Configure ($default_config, @{$atts{config}});
165 $self->{settings} = Getopt::Long::Configure ($save);
166 delete ($atts{config});
168 # Else use default config.
170 $self->{settings} = $default_config;
173 if ( %atts ) { # Oops
174 die(__PACKAGE__.": unhandled attributes: ".
175 join(" ", sort(keys(%atts)))."\n");
184 # Restore settings, merge new settings in.
185 my $save = Getopt::Long::Configure ($self->{settings}, @_);
187 # Restore orig config and save the new config.
188 $self->{settings} = Getopt::Long::Configure ($save);
194 # Restore config settings.
195 my $save = Getopt::Long::Configure ($self->{settings});
199 $Getopt::Long::caller = $self->{caller_pkg};
202 # Locally set exception handler to default, otherwise it will
203 # be called implicitly here, and again explicitly when we try
204 # to deliver the messages.
205 local ($SIG{__DIE__}) = '__DEFAULT__';
206 $ret = Getopt::Long::GetOptions (@_);
209 # Restore saved settings.
210 Getopt::Long::Configure ($save);
212 # Handle errors and return value.
217 package Getopt::Long;
219 ################ Back to Normal ################
221 # Indices in option control info.
222 # Note that ParseOptions uses the fields directly. Search for 'hard-wired'.
223 use constant CTL_TYPE => 0;
224 #use constant CTL_TYPE_FLAG => '';
225 #use constant CTL_TYPE_NEG => '!';
226 #use constant CTL_TYPE_INCR => '+';
227 #use constant CTL_TYPE_INT => 'i';
228 #use constant CTL_TYPE_INTINC => 'I';
229 #use constant CTL_TYPE_XINT => 'o';
230 #use constant CTL_TYPE_FLOAT => 'f';
231 #use constant CTL_TYPE_STRING => 's';
233 use constant CTL_CNAME => 1;
235 use constant CTL_DEFAULT => 2;
237 use constant CTL_DEST => 3;
238 use constant CTL_DEST_SCALAR => 0;
239 use constant CTL_DEST_ARRAY => 1;
240 use constant CTL_DEST_HASH => 2;
241 use constant CTL_DEST_CODE => 3;
243 use constant CTL_AMIN => 4;
244 use constant CTL_AMAX => 5;
247 #use constant CTL_RANGE => ;
248 #use constant CTL_REPEAT => ;
252 my @optionlist = @_; # local copy of the option descriptions
253 my $argend = '--'; # option list terminator
254 my %opctl = (); # table of option specs
255 my $pkg = $caller || (caller)[0]; # current context
256 # Needed if linkage is omitted.
257 my @ret = (); # accum for non-options
258 my %linkage; # linkage
259 my $userlinkage; # user supplied HASH
260 my $opt; # current option
261 my $prefix = $genprefix; # current prefix
266 # Avoid some warnings if debugging.
269 ("Getopt::Long $Getopt::Long::VERSION (",
270 '$Revision: 2.72 $', ") ",
271 "called from package \"$pkg\".",
275 "autoabbrev=$autoabbrev,".
276 "bundling=$bundling,",
277 "getopt_compat=$getopt_compat,",
278 "gnu_compat=$gnu_compat,",
281 "ignorecase=$ignorecase,",
282 "requested_version=$requested_version,",
283 "passthrough=$passthrough,",
284 "genprefix=\"$genprefix\",",
285 "longprefix=\"$longprefix\".",
289 # Check for ref HASH as first argument.
290 # First argument may be an object. It's OK to use this as long
291 # as it is really a hash underneath.
292 $userlinkage = undef;
293 if ( @optionlist && ref($optionlist[0]) and
294 "$optionlist[0]" =~ /^(?:.*\=)?HASH\([^\(]*\)$/ ) {
295 $userlinkage = shift (@optionlist);
296 print STDERR ("=> user linkage: $userlinkage\n") if $debug;
299 # See if the first element of the optionlist contains option
300 # starter characters.
301 # Be careful not to interpret '<>' as option starters.
302 if ( @optionlist && $optionlist[0] =~ /^\W+$/
303 && !($optionlist[0] eq '<>'
305 && ref($optionlist[1])) ) {
306 $prefix = shift (@optionlist);
307 # Turn into regexp. Needs to be parenthesized!
308 $prefix =~ s/(\W)/\\$1/g;
309 $prefix = "([" . $prefix . "])";
310 print STDERR ("=> prefix=\"$prefix\"\n") if $debug;
313 # Verify correctness of optionlist.
315 while ( @optionlist ) {
316 my $opt = shift (@optionlist);
318 # Strip leading prefix so people can specify "--foo=i" if they like.
319 $opt = $+ if $opt =~ /^$prefix+(.*)$/s;
321 if ( $opt eq '<>' ) {
322 if ( (defined $userlinkage)
323 && !(@optionlist > 0 && ref($optionlist[0]))
324 && (exists $userlinkage->{$opt})
325 && ref($userlinkage->{$opt}) ) {
326 unshift (@optionlist, $userlinkage->{$opt});
328 unless ( @optionlist > 0
329 && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) {
330 $error .= "Option spec <> requires a reference to a subroutine\n";
331 # Kill the linkage (to avoid another error).
333 if @optionlist && ref($optionlist[0]);
336 $linkage{'<>'} = shift (@optionlist);
341 my ($name, $orig) = ParseOptionSpec ($opt, \%opctl);
342 unless ( defined $name ) {
343 # Failed. $orig contains the error message. Sorry for the abuse.
345 # Kill the linkage (to avoid another error).
347 if @optionlist && ref($optionlist[0]);
351 # If no linkage is supplied in the @optionlist, copy it from
352 # the userlinkage if available.
353 if ( defined $userlinkage ) {
354 unless ( @optionlist > 0 && ref($optionlist[0]) ) {
355 if ( exists $userlinkage->{$orig} &&
356 ref($userlinkage->{$orig}) ) {
357 print STDERR ("=> found userlinkage for \"$orig\": ",
358 "$userlinkage->{$orig}\n")
360 unshift (@optionlist, $userlinkage->{$orig});
363 # Do nothing. Being undefined will be handled later.
369 # Copy the linkage. If omitted, link to global variable.
370 if ( @optionlist > 0 && ref($optionlist[0]) ) {
371 print STDERR ("=> link \"$orig\" to $optionlist[0]\n")
373 my $rl = ref($linkage{$orig} = shift (@optionlist));
375 if ( $rl eq "ARRAY" ) {
376 $opctl{$name}[CTL_DEST] = CTL_DEST_ARRAY;
378 elsif ( $rl eq "HASH" ) {
379 $opctl{$name}[CTL_DEST] = CTL_DEST_HASH;
381 elsif ( $rl eq "SCALAR" ) {
382 # if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
383 # my $t = $linkage{$orig};
384 # $$t = $linkage{$orig} = [];
386 # elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
392 elsif ( $rl eq "CODE" ) {
396 $error .= "Invalid option linkage for \"$opt\"\n";
400 # Link to global $opt_XXX variable.
401 # Make sure a valid perl identifier results.
404 if ( $opctl{$name}[CTL_DEST] == CTL_DEST_ARRAY ) {
405 print STDERR ("=> link \"$orig\" to \@$pkg","::opt_$ov\n")
407 eval ("\$linkage{\$orig} = \\\@".$pkg."::opt_$ov;");
409 elsif ( $opctl{$name}[CTL_DEST] == CTL_DEST_HASH ) {
410 print STDERR ("=> link \"$orig\" to \%$pkg","::opt_$ov\n")
412 eval ("\$linkage{\$orig} = \\\%".$pkg."::opt_$ov;");
415 print STDERR ("=> link \"$orig\" to \$$pkg","::opt_$ov\n")
417 eval ("\$linkage{\$orig} = \\\$".$pkg."::opt_$ov;");
422 # Bail out if errors found.
423 die ($error) if $error;
426 # Supply --version and --help support, if needed and allowed.
427 if ( defined($auto_version) ? $auto_version : ($requested_version >= 2.3203) ) {
428 if ( !defined($opctl{version}) ) {
429 $opctl{version} = ['','version',0,CTL_DEST_CODE,undef];
430 $linkage{version} = \&VersionMessage;
434 if ( defined($auto_help) ? $auto_help : ($requested_version >= 2.3203) ) {
435 if ( !defined($opctl{help}) && !defined($opctl{'?'}) ) {
436 $opctl{help} = $opctl{'?'} = ['','help',0,CTL_DEST_CODE,undef];
437 $linkage{help} = \&HelpMessage;
442 # Show the options tables if debugging.
446 while ( ($k,$v) = each(%opctl) ) {
447 print STDERR ($arrow, "\$opctl{$k} = $v ", OptCtl($v), "\n");
452 # Process argument list
454 while ( $goon && @ARGV > 0 ) {
457 $opt = shift (@ARGV);
458 print STDERR ("=> arg \"", $opt, "\"\n") if $debug;
460 # Double dash is option list terminator.
461 if ( $opt eq $argend ) {
462 push (@ret, $argend) if $passthrough;
468 my $found; # success status
469 my $key; # key (if hash type)
470 my $arg; # option argument
471 my $ctl; # the opctl entry
473 ($found, $opt, $ctl, $arg, $key) =
474 FindOption ($prefix, $argend, $opt, \%opctl);
478 # FindOption undefines $opt in case of errors.
479 next unless defined $opt;
482 while ( defined $arg ) {
484 # Get the canonical name.
485 print STDERR ("=> cname for \"$opt\" is ") if $debug;
486 $opt = $ctl->[CTL_CNAME];
487 print STDERR ("\"$ctl->[CTL_CNAME]\"\n") if $debug;
489 if ( defined $linkage{$opt} ) {
490 print STDERR ("=> ref(\$L{$opt}) -> ",
491 ref($linkage{$opt}), "\n") if $debug;
493 if ( ref($linkage{$opt}) eq 'SCALAR' ) {
494 if ( $ctl->[CTL_TYPE] eq '+' ) {
495 print STDERR ("=> \$\$L{$opt} += \"$arg\"\n")
497 if ( defined ${$linkage{$opt}} ) {
498 ${$linkage{$opt}} += $arg;
501 ${$linkage{$opt}} = $arg;
504 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
505 print STDERR ("=> ref(\$L{$opt}) auto-vivified",
508 my $t = $linkage{$opt};
509 $$t = $linkage{$opt} = [];
510 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
512 push (@{$linkage{$opt}}, $arg);
514 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
515 print STDERR ("=> ref(\$L{$opt}) auto-vivified",
518 my $t = $linkage{$opt};
519 $$t = $linkage{$opt} = {};
520 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
522 $linkage{$opt}->{$key} = $arg;
525 print STDERR ("=> \$\$L{$opt} = \"$arg\"\n")
527 ${$linkage{$opt}} = $arg;
530 elsif ( ref($linkage{$opt}) eq 'ARRAY' ) {
531 print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n")
533 push (@{$linkage{$opt}}, $arg);
535 elsif ( ref($linkage{$opt}) eq 'HASH' ) {
536 print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n")
538 $linkage{$opt}->{$key} = $arg;
540 elsif ( ref($linkage{$opt}) eq 'CODE' ) {
541 print STDERR ("=> &L{$opt}(\"$opt\"",
542 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ", \"$key\"" : "",
545 my $eval_error = do {
547 local $SIG{__DIE__} = '__DEFAULT__';
549 &{$linkage{$opt}}($opt,
550 $ctl->[CTL_DEST] == CTL_DEST_HASH ? ($key) : (),
555 print STDERR ("=> die($eval_error)\n")
556 if $debug && $eval_error ne '';
557 if ( $eval_error =~ /^!/ ) {
558 if ( $eval_error =~ /^!FINISH\b/ ) {
562 elsif ( $eval_error ne '' ) {
568 print STDERR ("Invalid REF type \"", ref($linkage{$opt}),
570 die("Getopt::Long -- internal error!\n");
573 # No entry in linkage means entry in userlinkage.
574 elsif ( $ctl->[CTL_DEST] == CTL_DEST_ARRAY ) {
575 if ( defined $userlinkage->{$opt} ) {
576 print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n")
578 push (@{$userlinkage->{$opt}}, $arg);
581 print STDERR ("=>\$L{$opt} = [\"$arg\"]\n")
583 $userlinkage->{$opt} = [$arg];
586 elsif ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
587 if ( defined $userlinkage->{$opt} ) {
588 print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n")
590 $userlinkage->{$opt}->{$key} = $arg;
593 print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n")
595 $userlinkage->{$opt} = {$key => $arg};
599 if ( $ctl->[CTL_TYPE] eq '+' ) {
600 print STDERR ("=> \$L{$opt} += \"$arg\"\n")
602 if ( defined $userlinkage->{$opt} ) {
603 $userlinkage->{$opt} += $arg;
606 $userlinkage->{$opt} = $arg;
610 print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug;
611 $userlinkage->{$opt} = $arg;
616 last if $argcnt >= $ctl->[CTL_AMAX] && $ctl->[CTL_AMAX] != -1;
620 if ( $argcnt < $ctl->[CTL_AMIN] ) {
622 if ( ValidValue($ctl, $ARGV[0], 1, $argend, $prefix) ) {
624 ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
625 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
628 warn("Value \"$ARGV[0]\" invalid for option $opt\n");
632 warn("Insufficient arguments for option $opt\n");
638 if ( @ARGV && ValidValue($ctl, $ARGV[0], 0, $argend, $prefix) ) {
640 ($key,$arg) = $arg =~ /^([^=]+)=(.*)/
641 if $ctl->[CTL_DEST] == CTL_DEST_HASH;
647 # Not an option. Save it if we $PERMUTE and don't have a <>.
648 elsif ( $order == $PERMUTE ) {
649 # Try non-options call-back.
651 if ( (defined ($cb = $linkage{'<>'})) ) {
652 print STDERR ("=> &L{$tryopt}(\"$tryopt\")\n")
654 my $eval_error = do {
656 local $SIG{__DIE__} = '__DEFAULT__';
657 eval { &$cb ($tryopt) };
660 print STDERR ("=> die($eval_error)\n")
661 if $debug && $eval_error ne '';
662 if ( $eval_error =~ /^!/ ) {
663 if ( $eval_error =~ /^!FINISH\b/ ) {
667 elsif ( $eval_error ne '' ) {
673 print STDERR ("=> saving \"$tryopt\" ",
674 "(not an option, may permute)\n") if $debug;
675 push (@ret, $tryopt);
680 # ...otherwise, terminate.
682 # Push this one back and exit.
683 unshift (@ARGV, $tryopt);
684 return ($error == 0);
690 if ( @ret && $order == $PERMUTE ) {
691 # Push back accumulated arguments
692 print STDERR ("=> restoring \"", join('" "', @ret), "\"\n")
694 unshift (@ARGV, @ret);
697 return ($error == 0);
700 # A readable representation of what's in an optbl.
703 my @v = map { defined($_) ? ($_) : ("<undef>") } @$v;
708 "\"$v[CTL_DEFAULT]\"",
709 ("\$","\@","\%","\&")[$v[CTL_DEST] || 0],
712 # $v[CTL_RANGE] || '',
713 # $v[CTL_REPEAT] || '',
717 # Parse an option specification and fill the tables.
718 sub ParseOptionSpec ($$) {
719 my ($opt, $opctl) = @_;
726 # Alias names, or "?"
727 (?: \| (?: \? | \w[-\w]* )? )*
730 # Either modifiers ...
733 # ... or a value/dest/repeat specification
734 [=:] [ionfs] [@%]? (?: \{\d*,?\d*\} )?
736 # ... or an optional-with-default spec
737 : (?: -?\d+ | \+ ) [@%]?
740 return (undef, "Error in option spec: \"$opt\"\n");
743 my ($names, $spec) = ($1, $2);
744 $spec = '' unless defined $spec;
746 # $orig keeps track of the primary name the user specified.
747 # This name will be used for the internal or external linkage.
748 # In other words, if the user specifies "FoO|BaR", it will
749 # match any case combinations of 'foo' and 'bar', but if a global
750 # variable needs to be set, it will be $opt_FoO in the exact case
755 if ( defined $names ) {
756 @names = split (/\|/, $names);
764 # Construct the opctl entries.
766 if ( $spec eq '' || $spec eq '+' || $spec eq '!' ) {
767 # Fields are hard-wired here.
768 $entry = [$spec,$orig,undef,CTL_DEST_SCALAR,0,0];
770 elsif ( $spec =~ /^:(-?\d+|\+)([@%])?$/ ) {
773 my $type = $def eq '+' ? 'I' : 'i';
775 $dest = $dest eq '@' ? CTL_DEST_ARRAY
776 : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
777 # Fields are hard-wired here.
778 $entry = [$type,$orig,$def eq '+' ? undef : $def,
782 my ($mand, $type, $dest) =
783 $spec =~ /^([=:])([ionfs])([@%])?(\{(\d+)?(,)?(\d+)?\})?$/;
784 return (undef, "Cannot repeat while bundling: \"$opt\"\n")
785 if $bundling && defined($4);
786 my ($mi, $cm, $ma) = ($5, $6, $7);
787 return (undef, "{0} is useless in option spec: \"$opt\"\n")
788 if defined($mi) && !$mi && !defined($ma) && !defined($cm);
790 $type = 'i' if $type eq 'n';
792 $dest = $dest eq '@' ? CTL_DEST_ARRAY
793 : $dest eq '%' ? CTL_DEST_HASH : CTL_DEST_SCALAR;
794 # Default minargs to 1/0 depending on mand status.
795 $mi = $mand eq '=' ? 1 : 0 unless defined $mi;
796 # Adjust mand status according to minargs.
797 $mand = $mi ? '=' : ':';
799 $ma = $mi ? $mi : 1 unless defined $ma || defined $cm;
800 return (undef, "Max must be greater than zero in option spec: \"$opt\"\n")
801 if defined($ma) && !$ma;
802 return (undef, "Max less than min in option spec: \"$opt\"\n")
803 if defined($ma) && $ma < $mi;
805 # Fields are hard-wired here.
806 $entry = [$type,$orig,undef,$dest,$mi,$ma||-1];
809 # Process all names. First is canonical, the rest are aliases.
814 if $ignorecase > (($bundling && length($_) == 1) ? 1 : 0);
816 if ( exists $opctl->{$_} ) {
817 $dups .= "Duplicate specification \"$opt\" for option \"$_\"\n";
820 if ( $spec eq '!' ) {
821 $opctl->{"no$_"} = $entry;
822 $opctl->{"no-$_"} = $entry;
823 $opctl->{$_} = [@$entry];
824 $opctl->{$_}->[CTL_TYPE] = '';
827 $opctl->{$_} = $entry;
831 if ( $dups && $^W ) {
832 foreach ( split(/\n+/, $dups) ) {
840 sub FindOption ($$$$) {
842 # returns (1, $opt, $ctl, $arg, $key) if okay,
843 # returns (1, undef) if option in error,
844 # returns (0) otherwise.
846 my ($prefix, $argend, $opt, $opctl) = @_;
848 print STDERR ("=> find \"$opt\"\n") if $debug;
850 return (0) unless $opt =~ /^$prefix(.*)$/s;
851 return (0) if $opt eq "-" && !defined $opctl->{''};
856 print STDERR ("=> split \"$starter\"+\"$opt\"\n") if $debug;
858 my $optarg; # value supplied with --opt=value
859 my $rest; # remainder from unbundling
861 # If it is a long option, it may include the value.
862 # With getopt_compat, only if not bundling.
863 if ( ($starter=~/^$longprefix$/
864 || ($getopt_compat && ($bundling == 0 || $bundling == 2)))
865 && $opt =~ /^([^=]+)=(.*)$/s ) {
868 print STDERR ("=> option \"", $opt,
869 "\", optarg = \"$optarg\"\n") if $debug;
874 my $tryopt = $opt; # option to try
876 if ( $bundling && $starter eq '-' ) {
878 # To try overrides, obey case ignore.
879 $tryopt = $ignorecase ? lc($opt) : $opt;
881 # If bundling == 2, long options can override bundles.
882 if ( $bundling == 2 && length($tryopt) > 1
883 && defined ($opctl->{$tryopt}) ) {
884 print STDERR ("=> $starter$tryopt overrides unbundling\n")
889 # Unbundle single letter option.
890 $rest = length ($tryopt) > 0 ? substr ($tryopt, 1) : '';
891 $tryopt = substr ($tryopt, 0, 1);
892 $tryopt = lc ($tryopt) if $ignorecase > 1;
893 print STDERR ("=> $starter$tryopt unbundled from ",
894 "$starter$tryopt$rest\n") if $debug;
895 $rest = undef unless $rest ne '';
899 # Try auto-abbreviation.
900 elsif ( $autoabbrev ) {
901 # Sort the possible long option names.
902 my @names = sort(keys (%$opctl));
903 # Downcase if allowed.
904 $opt = lc ($opt) if $ignorecase;
906 # Turn option name into pattern.
907 my $pat = quotemeta ($opt);
908 # Look up in option names.
909 my @hits = grep (/^$pat/, @names);
910 print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ",
911 "out of ", scalar(@names), "\n") if $debug;
913 # Check for ambiguous results.
914 unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) {
915 # See if all matches are for the same option.
919 $hit = $opctl->{$hit}->[CTL_CNAME]
920 if defined $opctl->{$hit}->[CTL_CNAME];
923 # Remove auto-supplied options (version, help).
924 if ( keys(%hit) == 2 ) {
925 if ( $auto_version && exists($hit{version}) ) {
926 delete $hit{version};
928 elsif ( $auto_help && exists($hit{help}) ) {
932 # Now see if it really is ambiguous.
933 unless ( keys(%hit) == 1 ) {
934 return (0) if $passthrough;
935 warn ("Option ", $opt, " is ambiguous (",
936 join(", ", @hits), ")\n");
943 # Complete the option name, if appropriate.
944 if ( @hits == 1 && $hits[0] ne $opt ) {
946 $tryopt = lc ($tryopt) if $ignorecase;
947 print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n")
952 # Map to all lowercase if ignoring case.
953 elsif ( $ignorecase ) {
957 # Check validity by fetching the info.
958 my $ctl = $opctl->{$tryopt};
959 unless ( defined $ctl ) {
960 return (0) if $passthrough;
961 # Pretend one char when bundling.
962 if ( $bundling == 1 && length($starter) == 1 ) {
963 $opt = substr($opt,0,1);
964 unshift (@ARGV, $starter.$rest) if defined $rest;
966 warn ("Unknown option: ", $opt, "\n");
972 print STDERR ("=> found ", OptCtl($ctl),
973 " for \"", $opt, "\"\n") if $debug;
975 #### Determine argument status ####
977 # If it is an option w/o argument, we're almost finished with it.
978 my $type = $ctl->[CTL_TYPE];
981 if ( $type eq '' || $type eq '!' || $type eq '+' ) {
982 if ( defined $optarg ) {
983 return (0) if $passthrough;
984 warn ("Option ", $opt, " does not take an argument\n");
988 elsif ( $type eq '' || $type eq '+' ) {
989 # Supply explicit value.
993 $opt =~ s/^no-?//i; # strip NO prefix
994 $arg = 0; # supply explicit value
996 unshift (@ARGV, $starter.$rest) if defined $rest;
997 return (1, $opt, $ctl, $arg);
1000 # Get mandatory status and type info.
1001 my $mand = $ctl->[CTL_AMIN];
1003 # Check if there is an option argument available.
1004 if ( $gnu_compat && defined $optarg && $optarg eq '' ) {
1005 return (1, $opt, $ctl, $type eq 's' ? '' : 0) unless $mand;
1006 $optarg = 0 unless $type eq 's';
1009 # Check if there is an option argument available.
1010 if ( defined $optarg
1012 : !(defined $rest || @ARGV > 0) ) {
1013 # Complain if this option needs an argument.
1015 return (0) if $passthrough;
1016 warn ("Option ", $opt, " requires an argument\n");
1020 if ( $type eq 'I' ) {
1021 # Fake incremental type.
1024 return (1, $opt, \@c, 1);
1026 return (1, $opt, $ctl,
1027 defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1028 $type eq 's' ? '' : 0);
1031 # Get (possibly optional) argument.
1032 $arg = (defined $rest ? $rest
1033 : (defined $optarg ? $optarg : shift (@ARGV)));
1035 # Get key if this is a "name=value" pair for a hash option.
1037 if ($ctl->[CTL_DEST] == CTL_DEST_HASH && defined $arg) {
1038 ($key, $arg) = ($arg =~ /^([^=]*)=(.*)$/s) ? ($1, $2)
1039 : ($arg, defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] :
1040 ($mand ? undef : ($type eq 's' ? "" : 1)));
1041 if (! defined $arg) {
1042 warn ("Option $opt, key \"$key\", requires a value\n");
1045 unshift (@ARGV, $starter.$rest) if defined $rest;
1050 #### Check if the argument is valid for this option ####
1052 my $key_valid = $ctl->[CTL_DEST] == CTL_DEST_HASH ? "[^=]+=" : "";
1054 if ( $type eq 's' ) { # string
1055 # A mandatory string takes anything.
1056 return (1, $opt, $ctl, $arg, $key) if $mand;
1058 # An optional string takes almost anything.
1059 return (1, $opt, $ctl, $arg, $key)
1060 if defined $optarg || defined $rest;
1061 return (1, $opt, $ctl, $arg, $key) if $arg eq "-"; # ??
1063 # Check for option or option list terminator.
1064 if ($arg eq $argend ||
1065 $arg =~ /^$prefix.+/) {
1067 unshift (@ARGV, $arg);
1068 # Supply empty value.
1073 elsif ( $type eq 'i' # numeric/integer
1074 || $type eq 'I' # numeric/integer w/ incr default
1075 || $type eq 'o' ) { # dec/oct/hex/bin value
1078 $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
1081 if ( $bundling && defined $rest
1082 && $rest =~ /^($key_valid)($o_valid)(.*)$/si ) {
1083 ($key, $arg, $rest) = ($1, $2, $+);
1085 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
1086 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
1088 elsif ( $arg =~ /^($o_valid)$/si ) {
1089 $arg = ($type eq 'o' && $arg =~ /^0/) ? oct($arg) : 0+$arg;
1092 if ( defined $optarg || $mand ) {
1093 if ( $passthrough ) {
1094 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
1095 unless defined $optarg;
1098 warn ("Value \"", $arg, "\" invalid for option ",
1100 $type eq 'o' ? "extended " : '',
1101 "number expected)\n");
1104 unshift (@ARGV, $starter.$rest) if defined $rest;
1109 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1110 if ( $type eq 'I' ) {
1111 # Fake incremental type.
1114 return (1, $opt, \@c, 1);
1116 # Supply default value.
1117 $arg = defined($ctl->[CTL_DEFAULT]) ? $ctl->[CTL_DEFAULT] : 0;
1122 elsif ( $type eq 'f' ) { # real number, int is also ok
1123 # We require at least one digit before a point or 'e',
1124 # and at least one digit following the point and 'e'.
1126 if ( $bundling && defined $rest &&
1127 $rest =~ /^($key_valid)([-+]?[0-9]+(\.[0-9]+)?([eE][-+]?[0-9]+)?)(.*)$/s ) {
1128 ($key, $arg, $rest) = ($1, $2, $+);
1130 unshift (@ARGV, $starter.$rest) if defined $rest && $rest ne '';
1132 elsif ( $arg !~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/ ) {
1133 if ( defined $optarg || $mand ) {
1134 if ( $passthrough ) {
1135 unshift (@ARGV, defined $rest ? $starter.$rest : $arg)
1136 unless defined $optarg;
1139 warn ("Value \"", $arg, "\" invalid for option ",
1140 $opt, " (real number expected)\n");
1143 unshift (@ARGV, $starter.$rest) if defined $rest;
1148 unshift (@ARGV, defined $rest ? $starter.$rest : $arg);
1149 # Supply default value.
1155 die("Getopt::Long internal error (Can't happen)\n");
1157 return (1, $opt, $ctl, $arg, $key);
1160 sub ValidValue ($$$$$) {
1161 my ($ctl, $arg, $mand, $argend, $prefix) = @_;
1163 if ( $ctl->[CTL_DEST] == CTL_DEST_HASH ) {
1164 return 0 unless $arg =~ /[^=]+=(.*)/;
1168 my $type = $ctl->[CTL_TYPE];
1170 if ( $type eq 's' ) { # string
1171 # A mandatory string takes anything.
1172 return (1) if $mand;
1174 return (1) if $arg eq "-";
1176 # Check for option or option list terminator.
1177 return 0 if $arg eq $argend || $arg =~ /^$prefix.+/;
1181 elsif ( $type eq 'i' # numeric/integer
1182 || $type eq 'I' # numeric/integer w/ incr default
1183 || $type eq 'o' ) { # dec/oct/hex/bin value
1186 $type eq 'o' ? "[-+]?[1-9][0-9]*|0x[0-9a-f]+|0b[01]+|0[0-7]*"
1189 return $arg =~ /^$o_valid$/si;
1192 elsif ( $type eq 'f' ) { # real number, int is also ok
1193 # We require at least one digit before a point or 'e',
1194 # and at least one digit following the point and 'e'.
1196 return $arg =~ /^[-+]?[0-9.]+(\.[0-9]+)?([eE][-+]?[0-9]+)?$/;
1198 die("ValidValue: Cannot happen\n");
1201 # Getopt::Long Configuration.
1206 [ $error, $debug, $major_version, $minor_version,
1207 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1208 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1211 if ( ref($options[0]) eq 'ARRAY' ) {
1212 ( $error, $debug, $major_version, $minor_version,
1213 $autoabbrev, $getopt_compat, $ignorecase, $bundling, $order,
1214 $gnu_compat, $passthrough, $genprefix, $auto_version, $auto_help,
1215 $longprefix ) = @{shift(@options)};
1219 foreach $opt ( @options ) {
1220 my $try = lc ($opt);
1222 if ( $try =~ /^no_?(.*)$/s ) {
1226 if ( ($try eq 'default' or $try eq 'defaults') && $action ) {
1229 elsif ( ($try eq 'posix_default' or $try eq 'posix_defaults') ) {
1230 local $ENV{POSIXLY_CORRECT};
1231 $ENV{POSIXLY_CORRECT} = 1 if $action;
1234 elsif ( $try eq 'auto_abbrev' or $try eq 'autoabbrev' ) {
1235 $autoabbrev = $action;
1237 elsif ( $try eq 'getopt_compat' ) {
1238 $getopt_compat = $action;
1240 elsif ( $try eq 'gnu_getopt' ) {
1248 elsif ( $try eq 'gnu_compat' ) {
1249 $gnu_compat = $action;
1251 elsif ( $try =~ /^(auto_?)?version$/ ) {
1252 $auto_version = $action;
1254 elsif ( $try =~ /^(auto_?)?help$/ ) {
1255 $auto_help = $action;
1257 elsif ( $try eq 'ignorecase' or $try eq 'ignore_case' ) {
1258 $ignorecase = $action;
1260 elsif ( $try eq 'ignore_case_always' ) {
1261 $ignorecase = $action ? 2 : 0;
1263 elsif ( $try eq 'bundling' ) {
1264 $bundling = $action;
1266 elsif ( $try eq 'bundling_override' ) {
1267 $bundling = $action ? 2 : 0;
1269 elsif ( $try eq 'require_order' ) {
1270 $order = $action ? $REQUIRE_ORDER : $PERMUTE;
1272 elsif ( $try eq 'permute' ) {
1273 $order = $action ? $PERMUTE : $REQUIRE_ORDER;
1275 elsif ( $try eq 'pass_through' or $try eq 'passthrough' ) {
1276 $passthrough = $action;
1278 elsif ( $try =~ /^prefix=(.+)$/ && $action ) {
1280 # Turn into regexp. Needs to be parenthesized!
1281 $genprefix = "(" . quotemeta($genprefix) . ")";
1282 eval { '' =~ /$genprefix/; };
1283 die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
1285 elsif ( $try =~ /^prefix_pattern=(.+)$/ && $action ) {
1287 # Parenthesize if needed.
1288 $genprefix = "(" . $genprefix . ")"
1289 unless $genprefix =~ /^\(.*\)$/;
1290 eval { '' =~ m"$genprefix"; };
1291 die("Getopt::Long: invalid pattern \"$genprefix\"") if $@;
1293 elsif ( $try =~ /^long_prefix_pattern=(.+)$/ && $action ) {
1295 # Parenthesize if needed.
1296 $longprefix = "(" . $longprefix . ")"
1297 unless $longprefix =~ /^\(.*\)$/;
1298 eval { '' =~ m"$longprefix"; };
1299 die("Getopt::Long: invalid long prefix pattern \"$longprefix\"") if $@;
1301 elsif ( $try eq 'debug' ) {
1305 die("Getopt::Long: unknown config parameter \"$opt\"")
1316 # Issue a standard message for --version.
1318 # The arguments are mostly the same as for Pod::Usage::pod2usage:
1320 # - a number (exit value)
1321 # - a string (lead in message)
1322 # - a hash with options. See Pod::Usage for details.
1324 sub VersionMessage(@) {
1326 my $pa = setup_pa_args("version", @_);
1328 my $v = $main::VERSION;
1329 my $fh = $pa->{-output} ||
1330 ($pa->{-exitval} eq "NOEXIT" || $pa->{-exitval} < 2) ? \*STDOUT : \*STDERR;
1332 print $fh (defined($pa->{-message}) ? $pa->{-message} : (),
1333 $0, defined $v ? " version $v" : (),
1335 "(", __PACKAGE__, "::", "GetOptions",
1337 defined($Getopt::Long::VERSION_STRING)
1338 ? $Getopt::Long::VERSION_STRING : $VERSION, ";",
1340 $] >= 5.006 ? sprintf("%vd", $^V) : $],
1342 exit($pa->{-exitval}) unless $pa->{-exitval} eq "NOEXIT";
1345 # Issue a standard message for --help.
1347 # The arguments are the same as for Pod::Usage::pod2usage:
1349 # - a number (exit value)
1350 # - a string (lead in message)
1351 # - a hash with options. See Pod::Usage for details.
1353 sub HelpMessage(@) {
1358 } || die("Cannot provide help: cannot load Pod::Usage\n");
1360 # Note that pod2usage will issue a warning if -exitval => NOEXIT.
1361 pod2usage(setup_pa_args("help", @_));
1365 # Helper routine to set up a normalized hash ref to be used as
1366 # argument to pod2usage.
1367 sub setup_pa_args($@) {
1368 my $tag = shift; # who's calling
1370 # If called by direct binding to an option, it will get the option
1371 # name and value as arguments. Remove these, if so.
1372 @_ = () if @_ == 2 && $_[0] eq $tag;
1382 # At this point, $pa can be a number (exit value), string
1383 # (message) or hash with options.
1385 if ( UNIVERSAL::isa($pa, 'HASH') ) {
1386 # Get rid of -msg vs. -message ambiguity.
1387 $pa->{-message} = $pa->{-msg};
1388 delete($pa->{-msg});
1390 elsif ( $pa =~ /^-?\d+$/ ) {
1391 $pa = { -exitval => $pa };
1394 $pa = { -message => $pa };
1397 # These are _our_ defaults.
1398 $pa->{-verbose} = 0 unless exists($pa->{-verbose});
1399 $pa->{-exitval} = 0 unless exists($pa->{-exitval});
1403 # Sneak way to know what version the user requested.
1405 $requested_version = $_[1];
1406 shift->SUPER::VERSION(@_);
1411 ################ Documentation ################
1415 Getopt::Long - Extended processing of command line options
1420 my $data = "file.dat";
1423 $result = GetOptions ("length=i" => \$length, # numeric
1424 "file=s" => \$data, # string
1425 "verbose" => \$verbose); # flag
1429 The Getopt::Long module implements an extended getopt function called
1430 GetOptions(). This function adheres to the POSIX syntax for command
1431 line options, with GNU extensions. In general, this means that options
1432 have long names instead of single letters, and are introduced with a
1433 double dash "--". Support for bundling of command line options, as was
1434 the case with the more traditional single-letter approach, is provided
1435 but not enabled by default.
1437 =head1 Command Line Options, an Introduction
1439 Command line operated programs traditionally take their arguments from
1440 the command line, for example filenames or other information that the
1441 program needs to know. Besides arguments, these programs often take
1442 command line I<options> as well. Options are not necessary for the
1443 program to work, hence the name 'option', but are used to modify its
1444 default behaviour. For example, a program could do its job quietly,
1445 but with a suitable option it could provide verbose information about
1448 Command line options come in several flavours. Historically, they are
1449 preceded by a single dash C<->, and consist of a single letter.
1453 Usually, these single-character options can be bundled:
1457 Options can have values, the value is placed after the option
1458 character. Sometimes with whitespace in between, sometimes not:
1462 Due to the very cryptic nature of these options, another style was
1463 developed that used long names. So instead of a cryptic C<-l> one
1464 could use the more descriptive C<--long>. To distinguish between a
1465 bundle of single-character options and a long one, two dashes are used
1466 to precede the option name. Early implementations of long options used
1467 a plus C<+> instead. Also, option values could be specified either
1476 The C<+> form is now obsolete and strongly deprecated.
1478 =head1 Getting Started with Getopt::Long
1480 Getopt::Long is the Perl5 successor of C<newgetopt.pl>. This was
1481 the first Perl module that provided support for handling the new style
1482 of command line options, hence the name Getopt::Long. This module
1483 also supports single-character options and bundling. In this case, the
1484 options are restricted to alphabetic characters only, and the
1485 characters C<?> and C<->.
1487 To use Getopt::Long from a Perl program, you must include the
1488 following line in your Perl program:
1492 This will load the core of the Getopt::Long module and prepare your
1493 program for using it. Most of the actual Getopt::Long code is not
1494 loaded until you really call one of its functions.
1496 In the default configuration, options names may be abbreviated to
1497 uniqueness, case does not matter, and a single dash is sufficient,
1498 even for long option names. Also, options may be placed between
1499 non-option arguments. See L<Configuring Getopt::Long> for more
1500 details on how to configure Getopt::Long.
1502 =head2 Simple options
1504 The most simple options are the ones that take no values. Their mere
1505 presence on the command line enables the option. Popular examples are:
1507 --all --verbose --quiet --debug
1509 Handling simple options is straightforward:
1511 my $verbose = ''; # option variable with default value (false)
1512 my $all = ''; # option variable with default value (false)
1513 GetOptions ('verbose' => \$verbose, 'all' => \$all);
1515 The call to GetOptions() parses the command line arguments that are
1516 present in C<@ARGV> and sets the option variable to the value C<1> if
1517 the option did occur on the command line. Otherwise, the option
1518 variable is not touched. Setting the option value to true is often
1519 called I<enabling> the option.
1521 The option name as specified to the GetOptions() function is called
1522 the option I<specification>. Later we'll see that this specification
1523 can contain more than just the option name. The reference to the
1524 variable is called the option I<destination>.
1526 GetOptions() will return a true value if the command line could be
1527 processed successfully. Otherwise, it will write error messages to
1528 STDERR, and return a false result.
1530 =head2 A little bit less simple options
1532 Getopt::Long supports two useful variants of simple options:
1533 I<negatable> options and I<incremental> options.
1535 A negatable option is specified with an exclamation mark C<!> after the
1538 my $verbose = ''; # option variable with default value (false)
1539 GetOptions ('verbose!' => \$verbose);
1541 Now, using C<--verbose> on the command line will enable C<$verbose>,
1542 as expected. But it is also allowed to use C<--noverbose>, which will
1543 disable C<$verbose> by setting its value to C<0>. Using a suitable
1544 default value, the program can find out whether C<$verbose> is false
1545 by default, or disabled by using C<--noverbose>.
1547 An incremental option is specified with a plus C<+> after the
1550 my $verbose = ''; # option variable with default value (false)
1551 GetOptions ('verbose+' => \$verbose);
1553 Using C<--verbose> on the command line will increment the value of
1554 C<$verbose>. This way the program can keep track of how many times the
1555 option occurred on the command line. For example, each occurrence of
1556 C<--verbose> could increase the verbosity level of the program.
1558 =head2 Mixing command line option with other arguments
1560 Usually programs take command line options as well as other arguments,
1561 for example, file names. It is good practice to always specify the
1562 options first, and the other arguments last. Getopt::Long will,
1563 however, allow the options and arguments to be mixed and 'filter out'
1564 all the options before passing the rest of the arguments to the
1565 program. To stop Getopt::Long from processing further arguments,
1566 insert a double dash C<--> on the command line:
1570 In this example, C<--all> will I<not> be treated as an option, but
1571 passed to the program unharmed, in C<@ARGV>.
1573 =head2 Options with values
1575 For options that take values it must be specified whether the option
1576 value is required or not, and what kind of value the option expects.
1578 Three kinds of values are supported: integer numbers, floating point
1579 numbers, and strings.
1581 If the option value is required, Getopt::Long will take the
1582 command line argument that follows the option and assign this to the
1583 option variable. If, however, the option value is specified as
1584 optional, this will only be done if that value does not look like a
1585 valid command line option itself.
1587 my $tag = ''; # option variable with default value
1588 GetOptions ('tag=s' => \$tag);
1590 In the option specification, the option name is followed by an equals
1591 sign C<=> and the letter C<s>. The equals sign indicates that this
1592 option requires a value. The letter C<s> indicates that this value is
1593 an arbitrary string. Other possible value types are C<i> for integer
1594 values, and C<f> for floating point values. Using a colon C<:> instead
1595 of the equals sign indicates that the option value is optional. In
1596 this case, if no suitable value is supplied, string valued options get
1597 an empty string C<''> assigned, while numeric options are set to C<0>.
1599 =head2 Options with multiple values
1601 Options sometimes take several values. For example, a program could
1602 use multiple directories to search for library files:
1604 --library lib/stdlib --library lib/extlib
1606 To accomplish this behaviour, simply specify an array reference as the
1607 destination for the option:
1609 GetOptions ("library=s" => \@libfiles);
1611 Alternatively, you can specify that the option can have multiple
1612 values by adding a "@", and pass a scalar reference as the
1615 GetOptions ("library=s@" => \$libfiles);
1617 Used with the example above, C<@libfiles> (or C<@$libfiles>) would
1618 contain two strings upon completion: C<"lib/srdlib"> and
1619 C<"lib/extlib">, in that order. It is also possible to specify that
1620 only integer or floating point numbers are acceptible values.
1622 Often it is useful to allow comma-separated lists of values as well as
1623 multiple occurrences of the options. This is easy using Perl's split()
1624 and join() operators:
1626 GetOptions ("library=s" => \@libfiles);
1627 @libfiles = split(/,/,join(',',@libfiles));
1629 Of course, it is important to choose the right separator string for
1632 Warning: What follows is an experimental feature.
1634 Options can take multiple values at once, for example
1636 --coordinates 52.2 16.4 --rgbcolor 255 255 149
1638 This can be accomplished by adding a repeat specifier to the option
1639 specification. Repeat specifiers are very similar to the C<{...}>
1640 repeat specifiers that can be used with regular expression patterns.
1641 For example, the above command line would be handled as follows:
1643 GetOptions('coordinates=f{2}' => \@coor, 'rgbcolor=i{3}' => \@color);
1645 The destination for the option must be an array or array reference.
1647 It is also possible to specify the minimal and maximal number of
1648 arguments an option takes. C<foo=s{2,4}> indicates an option that
1649 takes at least two and at most 4 arguments. C<foo=s{,}> indicates one
1650 or more values; C<foo:s{,}> indicates zero or more option values.
1652 =head2 Options with hash values
1654 If the option destination is a reference to a hash, the option will
1655 take, as value, strings of the form I<key>C<=>I<value>. The value will
1656 be stored with the specified key in the hash.
1658 GetOptions ("define=s" => \%defines);
1660 Alternatively you can use:
1662 GetOptions ("define=s%" => \$defines);
1664 When used with command line options:
1666 --define os=linux --define vendor=redhat
1668 the hash C<%defines> (or C<%$defines>) will contain two keys, C<"os">
1669 with value C<"linux> and C<"vendor"> with value C<"redhat">. It is
1670 also possible to specify that only integer or floating point numbers
1671 are acceptible values. The keys are always taken to be strings.
1673 =head2 User-defined subroutines to handle options
1675 Ultimate control over what should be done when (actually: each time)
1676 an option is encountered on the command line can be achieved by
1677 designating a reference to a subroutine (or an anonymous subroutine)
1678 as the option destination. When GetOptions() encounters the option, it
1679 will call the subroutine with two or three arguments. The first
1680 argument is the name of the option. For a scalar or array destination,
1681 the second argument is the value to be stored. For a hash destination,
1682 the second arguments is the key to the hash, and the third argument
1683 the value to be stored. It is up to the subroutine to store the value,
1684 or do whatever it thinks is appropriate.
1686 A trivial application of this mechanism is to implement options that
1687 are related to each other. For example:
1689 my $verbose = ''; # option variable with default value (false)
1690 GetOptions ('verbose' => \$verbose,
1691 'quiet' => sub { $verbose = 0 });
1693 Here C<--verbose> and C<--quiet> control the same variable
1694 C<$verbose>, but with opposite values.
1696 If the subroutine needs to signal an error, it should call die() with
1697 the desired error message as its argument. GetOptions() will catch the
1698 die(), issue the error message, and record that an error result must
1699 be returned upon completion.
1701 If the text of the error message starts with an exclamantion mark C<!>
1702 it is interpreted specially by GetOptions(). There is currently one
1703 special command implemented: C<die("!FINISH")> will cause GetOptions()
1704 to stop processing options, as if it encountered a double dash C<-->.
1706 =head2 Options with multiple names
1708 Often it is user friendly to supply alternate mnemonic names for
1709 options. For example C<--height> could be an alternate name for
1710 C<--length>. Alternate names can be included in the option
1711 specification, separated by vertical bar C<|> characters. To implement
1714 GetOptions ('length|height=f' => \$length);
1716 The first name is called the I<primary> name, the other names are
1717 called I<aliases>. When using a hash to store options, the key will
1718 always be the primary name.
1720 Multiple alternate names are possible.
1722 =head2 Case and abbreviations
1724 Without additional configuration, GetOptions() will ignore the case of
1725 option names, and allow the options to be abbreviated to uniqueness.
1727 GetOptions ('length|height=f' => \$length, "head" => \$head);
1729 This call will allow C<--l> and C<--L> for the length option, but
1730 requires a least C<--hea> and C<--hei> for the head and height options.
1732 =head2 Summary of Option Specifications
1734 Each option specifier consists of two parts: the name specification
1735 and the argument specification.
1737 The name specification contains the name of the option, optionally
1738 followed by a list of alternative names separated by vertical bar
1741 length option name is "length"
1742 length|size|l name is "length", aliases are "size" and "l"
1744 The argument specification is optional. If omitted, the option is
1745 considered boolean, a value of 1 will be assigned when the option is
1746 used on the command line.
1748 The argument specification can be
1754 The option does not take an argument and may be negated, i.e. prefixed
1755 by "no". E.g. C<"foo!"> will allow C<--foo> (a value of 1 will be
1756 assigned) and C<--nofoo> and C<--no-foo> (a value of 0 will be assigned). If the
1757 option has aliases, this applies to the aliases as well.
1759 Using negation on a single letter option when bundling is in effect is
1760 pointless and will result in a warning.
1764 The option does not take an argument and will be incremented by 1
1765 every time it appears on the command line. E.g. C<"more+">, when used
1766 with C<--more --more --more>, will increment the value three times,
1767 resulting in a value of 3 (provided it was 0 or undefined at first).
1769 The C<+> specifier is ignored if the option destination is not a scalar.
1771 =item = I<type> [ I<desttype> ] [ I<repeat> ]
1773 The option requires an argument of the given type. Supported types
1780 String. An arbitrary sequence of characters. It is valid for the
1781 argument to start with C<-> or C<-->.
1785 Integer. An optional leading plus or minus sign, followed by a
1790 Extended integer, Perl style. This can be either an optional leading
1791 plus or minus sign, followed by a sequence of digits, or an octal
1792 string (a zero, optionally followed by '0', '1', .. '7'), or a
1793 hexadecimal string (C<0x> followed by '0' .. '9', 'a' .. 'f', case
1794 insensitive), or a binary string (C<0b> followed by a series of '0'
1799 Real number. For example C<3.14>, C<-6.23E24> and so on.
1803 The I<desttype> can be C<@> or C<%> to specify that the option is
1804 list or a hash valued. This is only needed when the destination for
1805 the option value is not otherwise specified. It should be omitted when
1808 The I<repeat> specifies the number of values this option takes per
1809 occurrence on the command line. It has the format C<{> [ I<min> ] [ C<,> [ I<max> ] ] C<}>.
1811 I<min> denotes the minimal number of arguments. It defaults to 1 for
1812 options with C<=> and to 0 for options with C<:>, see below. Note that
1813 I<min> overrules the C<=> / C<:> semantics.
1815 I<max> denotes the maximum number of arguments. It must be at least
1816 I<min>. If I<max> is omitted, I<but the comma is not>, there is no
1817 upper bound to the number of argument values taken.
1819 =item : I<type> [ I<desttype> ]
1821 Like C<=>, but designates the argument as optional.
1822 If omitted, an empty string will be assigned to string values options,
1823 and the value zero to numeric options.
1825 Note that if a string argument starts with C<-> or C<-->, it will be
1826 considered an option on itself.
1828 =item : I<number> [ I<desttype> ]
1830 Like C<:i>, but if the value is omitted, the I<number> will be assigned.
1832 =item : + [ I<desttype> ]
1834 Like C<:i>, but if the value is omitted, the current value for the
1835 option will be incremented.
1839 =head1 Advanced Possibilities
1841 =head2 Object oriented interface
1843 Getopt::Long can be used in an object oriented way as well:
1846 $p = new Getopt::Long::Parser;
1847 $p->configure(...configuration options...);
1848 if ($p->getoptions(...options descriptions...)) ...
1850 Configuration options can be passed to the constructor:
1852 $p = new Getopt::Long::Parser
1853 config => [...configuration options...];
1855 =head2 Thread Safety
1857 Getopt::Long is thread safe when using ithreads as of Perl 5.8. It is
1858 I<not> thread safe when using the older (experimental and now
1859 obsolete) threads implementation that was added to Perl 5.005.
1861 =head2 Documentation and help texts
1863 Getopt::Long encourages the use of Pod::Usage to produce help
1864 messages. For example:
1872 GetOptions('help|?' => \$help, man => \$man) or pod2usage(2);
1873 pod2usage(1) if $help;
1874 pod2usage(-exitstatus => 0, -verbose => 2) if $man;
1880 sample - Using Getopt::Long and Pod::Usage
1884 sample [options] [file ...]
1887 -help brief help message
1888 -man full documentation
1896 Print a brief help message and exits.
1900 Prints the manual page and exits.
1906 B<This program> will read the given input file(s) and do someting
1907 useful with the contents thereof.
1911 See L<Pod::Usage> for details.
1913 =head2 Storing options in a hash
1915 Sometimes, for example when there are a lot of options, having a
1916 separate variable for each of them can be cumbersome. GetOptions()
1917 supports, as an alternative mechanism, storing options in a hash.
1919 To obtain this, a reference to a hash must be passed I<as the first
1920 argument> to GetOptions(). For each option that is specified on the
1921 command line, the option value will be stored in the hash with the
1922 option name as key. Options that are not actually used on the command
1923 line will not be put in the hash, on other words,
1924 C<exists($h{option})> (or defined()) can be used to test if an option
1925 was used. The drawback is that warnings will be issued if the program
1926 runs under C<use strict> and uses C<$h{option}> without testing with
1927 exists() or defined() first.
1930 GetOptions (\%h, 'length=i'); # will store in $h{length}
1932 For options that take list or hash values, it is necessary to indicate
1933 this by appending an C<@> or C<%> sign after the type:
1935 GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
1937 To make things more complicated, the hash may contain references to
1938 the actual destinations, for example:
1941 my %h = ('length' => \$len);
1942 GetOptions (\%h, 'length=i'); # will store in $len
1944 This example is fully equivalent with:
1947 GetOptions ('length=i' => \$len); # will store in $len
1949 Any mixture is possible. For example, the most frequently used options
1950 could be stored in variables while all other options get stored in the
1953 my $verbose = 0; # frequently referred
1954 my $debug = 0; # frequently referred
1955 my %h = ('verbose' => \$verbose, 'debug' => \$debug);
1956 GetOptions (\%h, 'verbose', 'debug', 'filter', 'size=i');
1957 if ( $verbose ) { ... }
1958 if ( exists $h{filter} ) { ... option 'filter' was specified ... }
1962 With bundling it is possible to set several single-character options
1963 at once. For example if C<a>, C<v> and C<x> are all valid options,
1967 would set all three.
1969 Getopt::Long supports two levels of bundling. To enable bundling, a
1970 call to Getopt::Long::Configure is required.
1972 The first level of bundling can be enabled with:
1974 Getopt::Long::Configure ("bundling");
1976 Configured this way, single-character options can be bundled but long
1977 options B<must> always start with a double dash C<--> to avoid
1978 abiguity. For example, when C<vax>, C<a>, C<v> and C<x> are all valid
1983 would set C<a>, C<v> and C<x>, but
1989 The second level of bundling lifts this restriction. It can be enabled
1992 Getopt::Long::Configure ("bundling_override");
1994 Now, C<-vax> would set the option C<vax>.
1996 When any level of bundling is enabled, option values may be inserted
1997 in the bundle. For example:
2005 When configured for bundling, single-character options are matched
2006 case sensitive while long options are matched case insensitive. To
2007 have the single-character options matched case insensitive as well,
2010 Getopt::Long::Configure ("bundling", "ignorecase_always");
2012 It goes without saying that bundling can be quite confusing.
2014 =head2 The lonesome dash
2016 Normally, a lone dash C<-> on the command line will not be considered
2017 an option. Option processing will terminate (unless "permute" is
2018 configured) and the dash will be left in C<@ARGV>.
2020 It is possible to get special treatment for a lone dash. This can be
2021 achieved by adding an option specification with an empty name, for
2024 GetOptions ('' => \$stdio);
2026 A lone dash on the command line will now be a legal option, and using
2027 it will set variable C<$stdio>.
2029 =head2 Argument callback
2031 A special option 'name' C<< <> >> can be used to designate a subroutine
2032 to handle non-option arguments. When GetOptions() encounters an
2033 argument that does not look like an option, it will immediately call this
2034 subroutine and passes it one parameter: the argument name.
2040 GetOptions ('width=i' => \$width, '<>' => \&process);
2042 When applied to the following command line:
2044 arg1 --width=72 arg2 --width=60 arg3
2047 C<process("arg1")> while C<$width> is C<80>,
2048 C<process("arg2")> while C<$width> is C<72>, and
2049 C<process("arg3")> while C<$width> is C<60>.
2051 This feature requires configuration option B<permute>, see section
2052 L<Configuring Getopt::Long>.
2054 =head1 Configuring Getopt::Long
2056 Getopt::Long can be configured by calling subroutine
2057 Getopt::Long::Configure(). This subroutine takes a list of quoted
2058 strings, each specifying a configuration option to be enabled, e.g.
2059 C<ignore_case>, or disabled, e.g. C<no_ignore_case>. Case does not
2060 matter. Multiple calls to Configure() are possible.
2062 Alternatively, as of version 2.24, the configuration options may be
2063 passed together with the C<use> statement:
2065 use Getopt::Long qw(:config no_ignore_case bundling);
2067 The following options are available:
2073 This option causes all configuration options to be reset to their
2078 This option causes all configuration options to be reset to their
2079 default values as if the environment variable POSIXLY_CORRECT had
2084 Allow option names to be abbreviated to uniqueness.
2085 Default is enabled unless environment variable
2086 POSIXLY_CORRECT has been set, in which case C<auto_abbrev> is disabled.
2090 Allow C<+> to start options.
2091 Default is enabled unless environment variable
2092 POSIXLY_CORRECT has been set, in which case C<getopt_compat> is disabled.
2096 C<gnu_compat> controls whether C<--opt=> is allowed, and what it should
2097 do. Without C<gnu_compat>, C<--opt=> gives an error. With C<gnu_compat>,
2098 C<--opt=> will give option C<opt> and empty value.
2099 This is the way GNU getopt_long() does it.
2103 This is a short way of setting C<gnu_compat> C<bundling> C<permute>
2104 C<no_getopt_compat>. With C<gnu_getopt>, command line handling should be
2105 fully compatible with GNU getopt_long().
2109 Whether command line arguments are allowed to be mixed with options.
2110 Default is disabled unless environment variable
2111 POSIXLY_CORRECT has been set, in which case C<require_order> is enabled.
2113 See also C<permute>, which is the opposite of C<require_order>.
2117 Whether command line arguments are allowed to be mixed with options.
2118 Default is enabled unless environment variable
2119 POSIXLY_CORRECT has been set, in which case C<permute> is disabled.
2120 Note that C<permute> is the opposite of C<require_order>.
2122 If C<permute> is enabled, this means that
2124 --foo arg1 --bar arg2 arg3
2128 --foo --bar arg1 arg2 arg3
2130 If an argument callback routine is specified, C<@ARGV> will always be
2131 empty upon succesful return of GetOptions() since all options have been
2132 processed. The only exception is when C<--> is used:
2134 --foo arg1 --bar arg2 -- arg3
2136 This will call the callback routine for arg1 and arg2, and then
2137 terminate GetOptions() leaving C<"arg2"> in C<@ARGV>.
2139 If C<require_order> is enabled, options processing
2140 terminates when the first non-option is encountered.
2142 --foo arg1 --bar arg2 arg3
2146 --foo -- arg1 --bar arg2 arg3
2148 If C<pass_through> is also enabled, options processing will terminate
2149 at the first unrecognized option, or non-option, whichever comes
2152 =item bundling (default: disabled)
2154 Enabling this option will allow single-character options to be
2155 bundled. To distinguish bundles from long option names, long options
2156 I<must> be introduced with C<--> and bundles with C<->.
2158 Note that, if you have options C<a>, C<l> and C<all>, and
2159 auto_abbrev enabled, possible arguments and option settings are:
2161 using argument sets option(s)
2162 ------------------------------------------
2165 -al, -la, -ala, -all,... a, l
2168 The suprising part is that C<--a> sets option C<a> (due to auto
2169 completion), not C<all>.
2171 Note: disabling C<bundling> also disables C<bundling_override>.
2173 =item bundling_override (default: disabled)
2175 If C<bundling_override> is enabled, bundling is enabled as with
2176 C<bundling> but now long option names override option bundles.
2178 Note: disabling C<bundling_override> also disables C<bundling>.
2180 B<Note:> Using option bundling can easily lead to unexpected results,
2181 especially when mixing long options and bundles. Caveat emptor.
2183 =item ignore_case (default: enabled)
2185 If enabled, case is ignored when matching long option names. If,
2186 however, bundling is enabled as well, single character options will be
2187 treated case-sensitive.
2189 With C<ignore_case>, option specifications for options that only
2190 differ in case, e.g., C<"foo"> and C<"Foo">, will be flagged as
2193 Note: disabling C<ignore_case> also disables C<ignore_case_always>.
2195 =item ignore_case_always (default: disabled)
2197 When bundling is in effect, case is ignored on single-character
2200 Note: disabling C<ignore_case_always> also disables C<ignore_case>.
2202 =item auto_version (default:disabled)
2204 Automatically provide support for the B<--version> option if
2205 the application did not specify a handler for this option itself.
2207 Getopt::Long will provide a standard version message that includes the
2208 program name, its version (if $main::VERSION is defined), and the
2209 versions of Getopt::Long and Perl. The message will be written to
2210 standard output and processing will terminate.
2212 C<auto_version> will be enabled if the calling program explicitly
2213 specified a version number higher than 2.32 in the C<use> or
2214 C<require> statement.
2216 =item auto_help (default:disabled)
2218 Automatically provide support for the B<--help> and B<-?> options if
2219 the application did not specify a handler for this option itself.
2221 Getopt::Long will provide a help message using module L<Pod::Usage>. The
2222 message, derived from the SYNOPSIS POD section, will be written to
2223 standard output and processing will terminate.
2225 C<auto_help> will be enabled if the calling program explicitly
2226 specified a version number higher than 2.32 in the C<use> or
2227 C<require> statement.
2229 =item pass_through (default: disabled)
2231 Options that are unknown, ambiguous or supplied with an invalid option
2232 value are passed through in C<@ARGV> instead of being flagged as
2233 errors. This makes it possible to write wrapper scripts that process
2234 only part of the user supplied command line arguments, and pass the
2235 remaining options to some other program.
2237 If C<require_order> is enabled, options processing will terminate at
2238 the first unrecognized option, or non-option, whichever comes first.
2239 However, if C<permute> is enabled instead, results can become confusing.
2241 Note that the options terminator (default C<-->), if present, will
2242 also be passed through in C<@ARGV>.
2246 The string that starts options. If a constant string is not
2247 sufficient, see C<prefix_pattern>.
2249 =item prefix_pattern
2251 A Perl pattern that identifies the strings that introduce options.
2252 Default is C<--|-|\+> unless environment variable
2253 POSIXLY_CORRECT has been set, in which case it is C<--|->.
2255 =item long_prefix_pattern
2257 A Perl pattern that allows the disambiguation of long and short
2258 prefixes. Default is C<-->.
2260 Typically you only need to set this if you are using nonstandard
2261 prefixes and want some or all of them to have the same semantics as
2262 '--' does under normal circumstances.
2264 For example, setting prefix_pattern to C<--|-|\+|\/> and
2265 long_prefix_pattern to C<--|\/> would add Win32 style argument
2268 =item debug (default: disabled)
2270 Enable debugging output.
2274 =head1 Exportable Methods
2278 =item VersionMessage
2280 This subroutine provides a standard version message. Its argument can be:
2286 A string containing the text of a message to print I<before> printing
2287 the standard message.
2291 A numeric value corresponding to the desired exit status.
2295 A reference to a hash.
2299 If more than one argument is given then the entire argument list is
2300 assumed to be a hash. If a hash is supplied (either as a reference or
2301 as a list) it should contain one or more elements with the following
2310 The text of a message to print immediately prior to printing the
2311 program's usage message.
2315 The desired exit status to pass to the B<exit()> function.
2316 This should be an integer, or else the string "NOEXIT" to
2317 indicate that control should simply be returned without
2318 terminating the invoking process.
2322 A reference to a filehandle, or the pathname of a file to which the
2323 usage message should be written. The default is C<\*STDERR> unless the
2324 exit value is less than 2 (in which case the default is C<\*STDOUT>).
2328 You cannot tie this routine directly to an option, e.g.:
2330 GetOptions("version" => \&VersionMessage);
2334 GetOptions("version" => sub { VersionMessage() });
2338 This subroutine produces a standard help message, derived from the
2339 program's POD section SYNOPSIS using L<Pod::Usage>. It takes the same
2340 arguments as VersionMessage(). In particular, you cannot tie it
2341 directly to an option, e.g.:
2343 GetOptions("help" => \&HelpMessage);
2347 GetOptions("help" => sub { HelpMessage() });
2351 =head1 Return values and Errors
2353 Configuration errors and errors in the option definitions are
2354 signalled using die() and will terminate the calling program unless
2355 the call to Getopt::Long::GetOptions() was embedded in C<eval { ...
2356 }>, or die() was trapped using C<$SIG{__DIE__}>.
2358 GetOptions returns true to indicate success.
2359 It returns false when the function detected one or more errors during
2360 option parsing. These errors are signalled using warn() and can be
2361 trapped with C<$SIG{__WARN__}>.
2365 The earliest development of C<newgetopt.pl> started in 1990, with Perl
2366 version 4. As a result, its development, and the development of
2367 Getopt::Long, has gone through several stages. Since backward
2368 compatibility has always been extremely important, the current version
2369 of Getopt::Long still supports a lot of constructs that nowadays are
2370 no longer necessary or otherwise unwanted. This section describes
2371 briefly some of these 'features'.
2373 =head2 Default destinations
2375 When no destination is specified for an option, GetOptions will store
2376 the resultant value in a global variable named C<opt_>I<XXX>, where
2377 I<XXX> is the primary name of this option. When a progam executes
2378 under C<use strict> (recommended), these variables must be
2379 pre-declared with our() or C<use vars>.
2381 our $opt_length = 0;
2382 GetOptions ('length=i'); # will store in $opt_length
2384 To yield a usable Perl variable, characters that are not part of the
2385 syntax for variables are translated to underscores. For example,
2386 C<--fpp-struct-return> will set the variable
2387 C<$opt_fpp_struct_return>. Note that this variable resides in the
2388 namespace of the calling program, not necessarily C<main>. For
2391 GetOptions ("size=i", "sizes=i@");
2393 with command line "-size 10 -sizes 24 -sizes 48" will perform the
2394 equivalent of the assignments
2397 @opt_sizes = (24, 48);
2399 =head2 Alternative option starters
2401 A string of alternative option starter characters may be passed as the
2402 first argument (or the first argument after a leading hash reference
2406 GetOptions ('/', 'length=i' => $len);
2408 Now the command line may look like:
2412 Note that to terminate options processing still requires a double dash
2415 GetOptions() will not interpret a leading C<< "<>" >> as option starters
2416 if the next argument is a reference. To force C<< "<" >> and C<< ">" >> as
2417 option starters, use C<< "><" >>. Confusing? Well, B<using a starter
2418 argument is strongly deprecated> anyway.
2420 =head2 Configuration variables
2422 Previous versions of Getopt::Long used variables for the purpose of
2423 configuring. Although manipulating these variables still work, it is
2424 strongly encouraged to use the C<Configure> routine that was introduced
2425 in version 2.17. Besides, it is much easier.
2427 =head1 Trouble Shooting
2429 =head2 GetOptions does not return a false result when an option is not supplied
2431 That's why they're called 'options'.
2433 =head2 GetOptions does not split the command line correctly
2435 The command line is not split by GetOptions, but by the command line
2436 interpreter (CLI). On Unix, this is the shell. On Windows, it is
2437 COMMAND.COM or CMD.EXE. Other operating systems have other CLIs.
2439 It is important to know that these CLIs may behave different when the
2440 command line contains special characters, in particular quotes or
2441 backslashes. For example, with Unix shells you can use single quotes
2442 (C<'>) and double quotes (C<">) to group words together. The following
2443 alternatives are equivalent on Unix:
2449 In case of doubt, insert the following statement in front of your Perl
2452 print STDERR (join("|",@ARGV),"\n");
2454 to verify how your CLI passes the arguments to the program.
2456 =head2 Undefined subroutine &main::GetOptions called
2458 Are you running Windows, and did you write
2462 (note the capital 'O')?
2464 =head2 How do I put a "-?" option into a Getopt::Long?
2466 You can only obtain this using an alias, and Getopt::Long of at least
2470 GetOptions ("help|?"); # -help and -? will both set $opt_help
2474 Johan Vromans <jvromans@squirrel.nl>
2476 =head1 COPYRIGHT AND DISCLAIMER
2478 This program is Copyright 1990,2005 by Johan Vromans.
2479 This program is free software; you can redistribute it and/or
2480 modify it under the terms of the Perl Artistic License or the
2481 GNU General Public License as published by the Free Software
2482 Foundation; either version 2 of the License, or (at your option) any
2485 This program is distributed in the hope that it will be useful,
2486 but WITHOUT ANY WARRANTY; without even the implied warranty of
2487 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
2488 GNU General Public License for more details.
2490 If you do not have a copy of the GNU General Public License write to
2491 the Free Software Foundation, Inc., 675 Mass Ave, Cambridge,