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