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