Commit | Line | Data |
---|---|---|
385588b3 | 1 | # GetOpt::Long.pm -- POSIX compatible options parsing |
404cbe93 | 2 | |
385588b3 | 3 | # RCS Status : $Id: GetoptLong.pm,v 2.6 1997-01-11 13:12:01+01 jv Exp $ |
404cbe93 | 4 | # Author : Johan Vromans |
5 | # Created On : Tue Sep 11 15:00:12 1990 | |
6 | # Last Modified By: Johan Vromans | |
385588b3 RM |
7 | # Last Modified On: Sat Jan 11 13:11:35 1997 |
8 | # Update Count : 506 | |
404cbe93 | 9 | # Status : Released |
10 | ||
385588b3 RM |
11 | package Getopt::Long; |
12 | require 5.000; | |
13 | require Exporter; | |
14 | ||
15 | @ISA = qw(Exporter); | |
16 | @EXPORT = qw(&GetOptions $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER); | |
17 | $VERSION = sprintf("%d.%02d", '$Revision: 2.6002 $ ' =~ /(\d+)\.(\d+)/); | |
18 | use vars qw($autoabbrev $getopt_compat $ignorecase $bundling $order | |
19 | $passthrough $error $debug | |
20 | $REQUIRE_ORDER $PERMUTE $RETURN_IN_ORDER | |
21 | $VERSION $major_version $minor_version); | |
22 | use strict; | |
23 | ||
f06db76b AD |
24 | =head1 NAME |
25 | ||
404cbe93 | 26 | GetOptions - extended processing of command line options |
f06db76b AD |
27 | |
28 | =head1 SYNOPSIS | |
29 | ||
404cbe93 | 30 | use Getopt::Long; |
31 | $result = GetOptions (...option-descriptions...); | |
f06db76b AD |
32 | |
33 | =head1 DESCRIPTION | |
34 | ||
35 | The Getopt::Long module implements an extended getopt function called | |
404cbe93 | 36 | GetOptions(). This function adheres to the POSIX syntax for command |
37 | line options, with GNU extensions. In general, this means that options | |
38 | have long names instead of single letters, and are introduced with a | |
88e49c4e | 39 | double dash "--". Support for bundling of command line options, as was |
40 | the case with the more traditional single-letter approach, is provided | |
41 | but not enabled by default. For example, the UNIX "ps" command can be | |
42 | given the command line "option" | |
f06db76b | 43 | |
404cbe93 | 44 | -vax |
f06db76b | 45 | |
404cbe93 | 46 | which means the combination of B<-v>, B<-a> and B<-x>. With the new |
47 | syntax B<--vax> would be a single option, probably indicating a | |
48 | computer architecture. | |
f06db76b | 49 | |
404cbe93 | 50 | Command line options can be used to set values. These values can be |
51 | specified in one of two ways: | |
f06db76b | 52 | |
404cbe93 | 53 | --size 24 |
54 | --size=24 | |
f06db76b | 55 | |
404cbe93 | 56 | GetOptions is called with a list of option-descriptions, each of which |
57 | consists of two elements: the option specifier and the option linkage. | |
58 | The option specifier defines the name of the option and, optionally, | |
59 | the value it can take. The option linkage is usually a reference to a | |
60 | variable that will be set when the option is used. For example, the | |
61 | following call to GetOptions: | |
f06db76b | 62 | |
404cbe93 | 63 | &GetOptions("size=i" => \$offset); |
64 | ||
65 | will accept a command line option "size" that must have an integer | |
66 | value. With a command line of "--size 24" this will cause the variable | |
67 | $offset to get the value 24. | |
68 | ||
69 | Alternatively, the first argument to GetOptions may be a reference to | |
70 | a HASH describing the linkage for the options. The following call is | |
71 | equivalent to the example above: | |
72 | ||
73 | %optctl = ("size" => \$offset); | |
74 | &GetOptions(\%optctl, "size=i"); | |
75 | ||
76 | Linkage may be specified using either of the above methods, or both. | |
77 | Linkage specified in the argument list takes precedence over the | |
78 | linkage specified in the HASH. | |
79 | ||
80 | The command line options are taken from array @ARGV. Upon completion | |
81 | of GetOptions, @ARGV will contain the rest (i.e. the non-options) of | |
82 | the command line. | |
16c18a90 | 83 | |
404cbe93 | 84 | Each option specifier designates the name of the option, optionally |
85 | followed by an argument specifier. Values for argument specifiers are: | |
86 | ||
87 | =over 8 | |
88 | ||
5f05dabc | 89 | =item E<lt>noneE<gt> |
404cbe93 | 90 | |
91 | Option does not take an argument. | |
92 | The option variable will be set to 1. | |
93 | ||
94 | =item ! | |
95 | ||
96 | Option does not take an argument and may be negated, i.e. prefixed by | |
97 | "no". E.g. "foo!" will allow B<--foo> (with value 1) and B<-nofoo> | |
98 | (with value 0). | |
99 | The option variable will be set to 1, or 0 if negated. | |
100 | ||
101 | =item =s | |
102 | ||
103 | Option takes a mandatory string argument. | |
104 | This string will be assigned to the option variable. | |
105 | Note that even if the string argument starts with B<-> or B<-->, it | |
106 | will not be considered an option on itself. | |
107 | ||
108 | =item :s | |
109 | ||
110 | Option takes an optional string argument. | |
111 | This string will be assigned to the option variable. | |
112 | If omitted, it will be assigned "" (an empty string). | |
113 | If the string argument starts with B<-> or B<-->, it | |
114 | will be considered an option on itself. | |
115 | ||
116 | =item =i | |
117 | ||
118 | Option takes a mandatory integer argument. | |
119 | This value will be assigned to the option variable. | |
120 | Note that the value may start with B<-> to indicate a negative | |
121 | value. | |
122 | ||
123 | =item :i | |
124 | ||
125 | Option takes an optional integer argument. | |
126 | This value will be assigned to the option variable. | |
127 | If omitted, the value 0 will be assigned. | |
128 | Note that the value may start with B<-> to indicate a negative | |
129 | value. | |
130 | ||
131 | =item =f | |
132 | ||
133 | Option takes a mandatory real number argument. | |
134 | This value will be assigned to the option variable. | |
135 | Note that the value may start with B<-> to indicate a negative | |
136 | value. | |
137 | ||
138 | =item :f | |
139 | ||
140 | Option takes an optional real number argument. | |
141 | This value will be assigned to the option variable. | |
142 | If omitted, the value 0 will be assigned. | |
143 | ||
144 | =back | |
145 | ||
146 | A lone dash B<-> is considered an option, the corresponding option | |
147 | name is the empty string. | |
148 | ||
149 | A double dash on itself B<--> signals end of the options list. | |
150 | ||
151 | =head2 Linkage specification | |
152 | ||
153 | The linkage specifier is optional. If no linkage is explicitly | |
154 | specified but a ref HASH is passed, GetOptions will place the value in | |
155 | the HASH. For example: | |
156 | ||
157 | %optctl = (); | |
158 | &GetOptions (\%optctl, "size=i"); | |
159 | ||
160 | will perform the equivalent of the assignment | |
161 | ||
162 | $optctl{"size"} = 24; | |
163 | ||
164 | For array options, a reference to an array is used, e.g.: | |
165 | ||
166 | %optctl = (); | |
167 | &GetOptions (\%optctl, "sizes=i@"); | |
168 | ||
169 | with command line "-sizes 24 -sizes 48" will perform the equivalent of | |
170 | the assignment | |
171 | ||
172 | $optctl{"sizes"} = [24, 48]; | |
173 | ||
381319f7 | 174 | For hash options (an option whose argument looks like "name=value"), |
175 | a reference to a hash is used, e.g.: | |
176 | ||
177 | %optctl = (); | |
178 | &GetOptions (\%optctl, "define=s%"); | |
179 | ||
180 | with command line "--define foo=hello --define bar=world" will perform the | |
181 | equivalent of the assignment | |
182 | ||
183 | $optctl{"define"} = {foo=>'hello', bar=>'world') | |
184 | ||
404cbe93 | 185 | If no linkage is explicitly specified and no ref HASH is passed, |
186 | GetOptions will put the value in a global variable named after the | |
187 | option, prefixed by "opt_". To yield a usable Perl variable, | |
188 | characters that are not part of the syntax for variables are | |
189 | translated to underscores. For example, "--fpp-struct-return" will set | |
190 | the variable $opt_fpp_struct_return. Note that this variable resides | |
191 | in the namespace of the calling program, not necessarily B<main>. | |
192 | For example: | |
193 | ||
194 | &GetOptions ("size=i", "sizes=i@"); | |
195 | ||
196 | with command line "-size 10 -sizes 24 -sizes 48" will perform the | |
197 | equivalent of the assignments | |
198 | ||
199 | $opt_size = 10; | |
200 | @opt_sizes = (24, 48); | |
201 | ||
202 | A lone dash B<-> is considered an option, the corresponding Perl | |
203 | identifier is $opt_ . | |
204 | ||
205 | The linkage specifier can be a reference to a scalar, a reference to | |
381319f7 | 206 | an array, a reference to a hash or a reference to a subroutine. |
404cbe93 | 207 | |
208 | If a REF SCALAR is supplied, the new value is stored in the referenced | |
209 | variable. If the option occurs more than once, the previous value is | |
210 | overwritten. | |
211 | ||
212 | If a REF ARRAY is supplied, the new value is appended (pushed) to the | |
213 | referenced array. | |
214 | ||
381319f7 | 215 | If a REF HASH is supplied, the option value should look like "key" or |
216 | "key=value" (if the "=value" is omitted then a value of 1 is implied). | |
217 | In this case, the element of the referenced hash with the key "key" | |
218 | is assigned "value". | |
219 | ||
404cbe93 | 220 | If a REF CODE is supplied, the referenced subroutine is called with |
221 | two arguments: the option name and the option value. | |
222 | The option name is always the true name, not an abbreviation or alias. | |
f06db76b | 223 | |
404cbe93 | 224 | =head2 Aliases and abbreviations |
f06db76b AD |
225 | |
226 | The option name may actually be a list of option names, separated by | |
404cbe93 | 227 | "|"s, e.g. "foo|bar|blech=s". In this example, "foo" is the true name |
5f05dabc | 228 | of this option. If no linkage is specified, options "foo", "bar" and |
404cbe93 | 229 | "blech" all will set $opt_foo. |
f06db76b AD |
230 | |
231 | Option names may be abbreviated to uniqueness, depending on | |
385588b3 | 232 | configuration variable $Getopt::Long::autoabbrev. |
f06db76b | 233 | |
404cbe93 | 234 | =head2 Non-option call-back routine |
f06db76b | 235 | |
5f05dabc | 236 | A special option specifier, E<lt>E<gt>, can be used to designate a subroutine |
404cbe93 | 237 | to handle non-option arguments. GetOptions will immediately call this |
238 | subroutine for every non-option it encounters in the options list. | |
239 | This subroutine gets the name of the non-option passed. | |
385588b3 | 240 | This feature requires $Getopt::Long::order to have the value $PERMUTE. |
404cbe93 | 241 | See also the examples. |
f06db76b | 242 | |
404cbe93 | 243 | =head2 Option starters |
f06db76b | 244 | |
404cbe93 | 245 | On the command line, options can start with B<-> (traditional), B<--> |
246 | (POSIX) and B<+> (GNU, now being phased out). The latter is not | |
247 | allowed if the environment variable B<POSIXLY_CORRECT> has been | |
248 | defined. | |
f06db76b AD |
249 | |
250 | Options that start with "--" may have an argument appended, separated | |
251 | with an "=", e.g. "--foo=bar". | |
252 | ||
404cbe93 | 253 | =head2 Return value |
f06db76b AD |
254 | |
255 | A return status of 0 (false) indicates that the function detected | |
256 | one or more errors. | |
257 | ||
404cbe93 | 258 | =head1 COMPATIBILITY |
259 | ||
260 | Getopt::Long::GetOptions() is the successor of | |
261 | B<newgetopt.pl> that came with Perl 4. It is fully upward compatible. | |
262 | In fact, the Perl 5 version of newgetopt.pl is just a wrapper around | |
263 | the module. | |
264 | ||
265 | If an "@" sign is appended to the argument specifier, the option is | |
381319f7 | 266 | treated as an array. Value(s) are not set, but pushed into array |
267 | @opt_name. If explicit linkage is supplied, this must be a reference | |
268 | to an ARRAY. | |
269 | ||
270 | If an "%" sign is appended to the argument specifier, the option is | |
271 | treated as a hash. Value(s) of the form "name=value" are set by | |
272 | setting the element of the hash %opt_name with key "name" to "value" | |
273 | (if the "=value" portion is omitted it defaults to 1). If explicit | |
274 | linkage is supplied, this must be a reference to a HASH. | |
404cbe93 | 275 | |
385588b3 RM |
276 | If configuration variable $Getopt::Long::getopt_compat is set to a |
277 | non-zero value, options that start with "+" or "-" may also include their | |
278 | arguments, e.g. "+foo=bar". This is for compatiblity with older | |
279 | implementations of the GNU "getopt" routine. | |
404cbe93 | 280 | |
281 | If the first argument to GetOptions is a string consisting of only | |
282 | non-alphanumeric characters, it is taken to specify the option starter | |
283 | characters. Everything starting with one of these characters from the | |
284 | starter will be considered an option. B<Using a starter argument is | |
285 | strongly deprecated.> | |
286 | ||
287 | For convenience, option specifiers may have a leading B<-> or B<-->, | |
288 | so it is possible to write: | |
289 | ||
290 | GetOptions qw(-foo=s --bar=i --ar=s); | |
291 | ||
f06db76b AD |
292 | =head1 EXAMPLES |
293 | ||
404cbe93 | 294 | If the option specifier is "one:i" (i.e. takes an optional integer |
295 | argument), then the following situations are handled: | |
f06db76b AD |
296 | |
297 | -one -two -> $opt_one = '', -two is next option | |
298 | -one -2 -> $opt_one = -2 | |
299 | ||
404cbe93 | 300 | Also, assume specifiers "foo=s" and "bar:s" : |
f06db76b AD |
301 | |
302 | -bar -xxx -> $opt_bar = '', '-xxx' is next option | |
303 | -foo -bar -> $opt_foo = '-bar' | |
304 | -foo -- -> $opt_foo = '--' | |
305 | ||
306 | In GNU or POSIX format, option names and values can be combined: | |
307 | ||
308 | +foo=blech -> $opt_foo = 'blech' | |
309 | --bar= -> $opt_bar = '' | |
310 | --bar=-- -> $opt_bar = '--' | |
311 | ||
1fef88e7 | 312 | Example of using variable references: |
404cbe93 | 313 | |
314 | $ret = &GetOptions ('foo=s', \$foo, 'bar=i', 'ar=s', \@ar); | |
315 | ||
316 | With command line options "-foo blech -bar 24 -ar xx -ar yy" | |
317 | this will result in: | |
318 | ||
5f05dabc | 319 | $foo = 'blech' |
404cbe93 | 320 | $opt_bar = 24 |
321 | @ar = ('xx','yy') | |
322 | ||
5f05dabc | 323 | Example of using the E<lt>E<gt> option specifier: |
404cbe93 | 324 | |
325 | @ARGV = qw(-foo 1 bar -foo 2 blech); | |
326 | &GetOptions("foo=i", \$myfoo, "<>", \&mysub); | |
327 | ||
328 | Results: | |
329 | ||
330 | &mysub("bar") will be called (with $myfoo being 1) | |
331 | &mysub("blech") will be called (with $myfoo being 2) | |
332 | ||
333 | Compare this with: | |
334 | ||
335 | @ARGV = qw(-foo 1 bar -foo 2 blech); | |
336 | &GetOptions("foo=i", \$myfoo); | |
337 | ||
338 | This will leave the non-options in @ARGV: | |
339 | ||
340 | $myfoo -> 2 | |
341 | @ARGV -> qw(bar blech) | |
342 | ||
385588b3 | 343 | =head1 CONFIGURATION VARIABLES |
404cbe93 | 344 | |
385588b3 RM |
345 | The following variables can be set to change the default behaviour of |
346 | GetOptions(): | |
404cbe93 | 347 | |
f06db76b AD |
348 | =over 12 |
349 | ||
385588b3 | 350 | =item $Getopt::Long::autoabbrev |
f06db76b AD |
351 | |
352 | Allow option names to be abbreviated to uniqueness. | |
385588b3 RM |
353 | Default is 1 unless environment variable |
354 | POSIXLY_CORRECT has been set. | |
f06db76b | 355 | |
385588b3 | 356 | =item $Getopt::Long::getopt_compat |
f06db76b AD |
357 | |
358 | Allow '+' to start options. | |
385588b3 RM |
359 | Default is 1 unless environment variable |
360 | POSIXLY_CORRECT has been set. | |
f06db76b | 361 | |
385588b3 | 362 | =item $Getopt::Long::order |
f06db76b AD |
363 | |
364 | Whether non-options are allowed to be mixed with | |
365 | options. | |
385588b3 RM |
366 | Default is $REQUIRE_ORDER if environment variable |
367 | POSIXLY_CORRECT has been set, $PERMUTE otherwise. | |
f06db76b | 368 | |
385588b3 | 369 | $PERMUTE means that |
404cbe93 | 370 | |
371 | -foo arg1 -bar arg2 arg3 | |
372 | ||
373 | is equivalent to | |
374 | ||
375 | -foo -bar arg1 arg2 arg3 | |
376 | ||
377 | If a non-option call-back routine is specified, @ARGV will always be | |
378 | empty upon succesful return of GetOptions since all options have been | |
379 | processed, except when B<--> is used: | |
380 | ||
381 | -foo arg1 -bar arg2 -- arg3 | |
382 | ||
383 | will call the call-back routine for arg1 and arg2, and terminate | |
384 | leaving arg2 in @ARGV. | |
385 | ||
385588b3 | 386 | If $Getopt::Long::order is $REQUIRE_ORDER, options processing |
404cbe93 | 387 | terminates when the first non-option is encountered. |
388 | ||
389 | -foo arg1 -bar arg2 arg3 | |
390 | ||
391 | is equivalent to | |
392 | ||
393 | -foo -- arg1 -bar arg2 arg3 | |
394 | ||
385588b3 RM |
395 | $RETURN_IN_ORDER is not supported by GetOptions(). |
396 | ||
397 | =item $Getopt::Long::bundling | |
f06db76b | 398 | |
88e49c4e | 399 | Setting this variable to a non-zero value will allow single-character |
400 | options to be bundled. To distinguish bundles from long option names, | |
401 | long options must be introduced with B<--> and single-character | |
402 | options (and bundles) with B<->. For example, | |
403 | ||
404 | ps -vax --vax | |
405 | ||
406 | would be equivalent to | |
407 | ||
408 | ps -v -a -x --vax | |
409 | ||
410 | provided "vax", "v", "a" and "x" have been defined to be valid | |
411 | options. | |
412 | ||
413 | Bundled options can also include a value in the bundle; this value has | |
414 | to be the last part of the bundle, e.g. | |
415 | ||
416 | scale -h24 -w80 | |
417 | ||
418 | is equivalent to | |
419 | ||
420 | scale -h 24 -w 80 | |
421 | ||
422 | B<Note:> Using option bundling can easily lead to unexpected results, | |
423 | especially when mixing long options and bundles. Caveat emptor. | |
424 | ||
385588b3 | 425 | =item $Getopt::Long::ignorecase |
88e49c4e | 426 | |
385588b3 RM |
427 | Ignore case when matching options. Default is 1. When bundling is in |
428 | effect, case is ignored on single-character options only if | |
429 | $Getopt::Long::ignorecase is greater than 1. | |
f06db76b | 430 | |
385588b3 | 431 | =item $Getopt::Long::passthrough |
381319f7 | 432 | |
433 | Unknown options are passed through in @ARGV instead of being flagged | |
434 | as errors. This makes it possible to write wrapper scripts that | |
435 | process only part of the user supplied options, and passes the | |
436 | remaining options to some other program. | |
437 | ||
385588b3 RM |
438 | This can be very confusing, especially when $Getopt::Long::order is |
439 | set to $PERMUTE. | |
381319f7 | 440 | |
404cbe93 | 441 | =item $Getopt::Long::VERSION |
f06db76b | 442 | |
404cbe93 | 443 | The version number of this Getopt::Long implementation in the format |
444 | C<major>.C<minor>. This can be used to have Exporter check the | |
445 | version, e.g. | |
f06db76b | 446 | |
385588b3 | 447 | use Getopt::Long 2.00; |
f06db76b | 448 | |
404cbe93 | 449 | You can inspect $Getopt::Long::major_version and |
450 | $Getopt::Long::minor_version for the individual components. | |
a0d0e21e | 451 | |
404cbe93 | 452 | =item $Getopt::Long::error |
a0d0e21e | 453 | |
404cbe93 | 454 | Internal error flag. May be incremented from a call-back routine to |
455 | cause options parsing to fail. | |
456 | ||
385588b3 RM |
457 | =item $Getopt::Long::debug |
458 | ||
459 | Enable copious debugging output. Default is 0. | |
460 | ||
404cbe93 | 461 | =back |
462 | ||
463 | =cut | |
a0d0e21e | 464 | |
385588b3 RM |
465 | ################ Introduction ################ |
466 | # | |
467 | # This program is Copyright 1990,1996 by Johan Vromans. | |
a0d0e21e LW |
468 | # This program is free software; you can redistribute it and/or |
469 | # modify it under the terms of the GNU General Public License | |
470 | # as published by the Free Software Foundation; either version 2 | |
471 | # of the License, or (at your option) any later version. | |
472 | # | |
473 | # This program is distributed in the hope that it will be useful, | |
474 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
475 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
476 | # GNU General Public License for more details. | |
477 | # | |
478 | # If you do not have a copy of the GNU General Public License write to | |
479 | # the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, | |
480 | # MA 02139, USA. | |
481 | ||
385588b3 | 482 | ################ Configuration Section ################ |
a0d0e21e | 483 | |
385588b3 RM |
484 | # Values for $order. See GNU getopt.c for details. |
485 | ($REQUIRE_ORDER, $PERMUTE, $RETURN_IN_ORDER) = (0..2); | |
a0d0e21e | 486 | |
385588b3 | 487 | my $gen_prefix; # generic prefix (option starters) |
a0d0e21e | 488 | |
385588b3 RM |
489 | # Handle POSIX compliancy. |
490 | if ( defined $ENV{"POSIXLY_CORRECT"} ) { | |
491 | $gen_prefix = "(--|-)"; | |
492 | $autoabbrev = 0; # no automatic abbrev of options | |
493 | $bundling = 0; # no bundling of single letter switches | |
494 | $getopt_compat = 0; # disallow '+' to start options | |
495 | $order = $REQUIRE_ORDER; | |
496 | } | |
497 | else { | |
498 | $gen_prefix = "(--|-|\\+)"; | |
499 | $autoabbrev = 1; # automatic abbrev of options | |
500 | $bundling = 0; # bundling off by default | |
501 | $getopt_compat = 1; # allow '+' to start options | |
502 | $order = $PERMUTE; | |
a0d0e21e LW |
503 | } |
504 | ||
385588b3 RM |
505 | # Other configurable settings. |
506 | $debug = 0; # for debugging | |
507 | $error = 0; # error tally | |
508 | $ignorecase = 1; # ignore case when matching options | |
509 | $passthrough = 0; # leave unrecognized options alone | |
510 | ($major_version, $minor_version) = $VERSION =~ /^(\d+)\.(\d+)/; | |
404cbe93 | 511 | |
385588b3 RM |
512 | use vars qw($genprefix %opctl @opctl %bopctl $opt $arg $argend $array); |
513 | use vars qw(%aliases $hash $key); | |
381319f7 | 514 | |
a0d0e21e LW |
515 | ################ Subroutines ################ |
516 | ||
517 | sub GetOptions { | |
518 | ||
404cbe93 | 519 | my @optionlist = @_; # local copy of the option descriptions |
385588b3 RM |
520 | local ($argend) = '--'; # option list terminator |
521 | local (%opctl); # table of arg.specs (long and abbrevs) | |
522 | local (%bopctl); # table of arg.specs (bundles) | |
523 | my $pkg = (caller)[0]; # current context | |
404cbe93 | 524 | # Needed if linkage is omitted. |
385588b3 | 525 | local (%aliases); # alias table |
404cbe93 | 526 | my @ret = (); # accum for non-options |
527 | my %linkage; # linkage | |
528 | my $userlinkage; # user supplied HASH | |
385588b3 RM |
529 | local ($genprefix) = $gen_prefix; # so we can call the same module more |
530 | # than once in differing environments | |
88e49c4e | 531 | $error = 0; |
404cbe93 | 532 | |
385588b3 | 533 | print STDERR ('GetOptions $Revision: 2.6001 $ ', |
88e49c4e | 534 | "[GetOpt::Long $Getopt::Long::VERSION] -- ", |
404cbe93 | 535 | "called from package \"$pkg\".\n", |
381319f7 | 536 | " (@ARGV)\n", |
88e49c4e | 537 | " autoabbrev=$autoabbrev". |
538 | ",bundling=$bundling", | |
539 | ",getopt_compat=$getopt_compat", | |
88e49c4e | 540 | ",order=$order", |
381319f7 | 541 | ",\n ignorecase=$ignorecase", |
542 | ",passthrough=$passthrough", | |
543 | ",genprefix=\"$genprefix\"", | |
404cbe93 | 544 | ".\n") |
545 | if $debug; | |
546 | ||
547 | # Check for ref HASH as first argument. | |
548 | $userlinkage = undef; | |
549 | if ( ref($optionlist[0]) && ref($optionlist[0]) eq 'HASH' ) { | |
550 | $userlinkage = shift (@optionlist); | |
551 | } | |
a0d0e21e LW |
552 | |
553 | # See if the first element of the optionlist contains option | |
554 | # starter characters. | |
555 | if ( $optionlist[0] =~ /^\W+$/ ) { | |
556 | $genprefix = shift (@optionlist); | |
557 | # Turn into regexp. | |
558 | $genprefix =~ s/(\W)/\\$1/g; | |
559 | $genprefix = "[" . $genprefix . "]"; | |
560 | } | |
561 | ||
562 | # Verify correctness of optionlist. | |
563 | %opctl = (); | |
88e49c4e | 564 | %bopctl = (); |
404cbe93 | 565 | while ( @optionlist > 0 ) { |
566 | my $opt = shift (@optionlist); | |
567 | ||
381319f7 | 568 | # Strip leading prefix so people can specify "--foo=i" if they like. |
385588b3 | 569 | $opt =~ s/^(?:$genprefix)+//s; |
404cbe93 | 570 | |
571 | if ( $opt eq '<>' ) { | |
572 | if ( (defined $userlinkage) | |
573 | && !(@optionlist > 0 && ref($optionlist[0])) | |
574 | && (exists $userlinkage->{$opt}) | |
575 | && ref($userlinkage->{$opt}) ) { | |
576 | unshift (@optionlist, $userlinkage->{$opt}); | |
577 | } | |
578 | unless ( @optionlist > 0 | |
579 | && ref($optionlist[0]) && ref($optionlist[0]) eq 'CODE' ) { | |
580 | warn ("Option spec <> requires a reference to a subroutine\n"); | |
88e49c4e | 581 | $error++; |
404cbe93 | 582 | next; |
583 | } | |
584 | $linkage{'<>'} = shift (@optionlist); | |
585 | next; | |
586 | } | |
587 | ||
381319f7 | 588 | if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse][@%]?)?$/ ) { |
404cbe93 | 589 | warn ("Error in option spec: \"", $opt, "\"\n"); |
88e49c4e | 590 | $error++; |
a0d0e21e LW |
591 | next; |
592 | } | |
404cbe93 | 593 | my ($o, $c, $a) = ($1, $2); |
88e49c4e | 594 | $c = '' unless defined $c; |
a0d0e21e LW |
595 | |
596 | if ( ! defined $o ) { | |
404cbe93 | 597 | # empty -> '-' option |
88e49c4e | 598 | $opctl{$o = ''} = $c; |
a0d0e21e LW |
599 | } |
600 | else { | |
601 | # Handle alias names | |
404cbe93 | 602 | my @o = split (/\|/, $o); |
381319f7 | 603 | my $linko = $o = $o[0]; |
604 | # Force an alias if the option name is not locase. | |
605 | $a = $o unless $o eq lc($o); | |
88e49c4e | 606 | $o = lc ($o) |
607 | if $ignorecase > 1 | |
608 | || ($ignorecase | |
609 | && ($bundling ? length($o) > 1 : 1)); | |
610 | ||
404cbe93 | 611 | foreach ( @o ) { |
88e49c4e | 612 | if ( $bundling && length($_) == 1 ) { |
613 | $_ = lc ($_) if $ignorecase > 1; | |
614 | if ( $c eq '!' ) { | |
615 | $opctl{"no$_"} = $c; | |
616 | warn ("Ignoring '!' modifier for short option $_\n"); | |
617 | $c = ''; | |
618 | } | |
619 | $bopctl{$_} = $c; | |
620 | } | |
621 | else { | |
622 | $_ = lc ($_) if $ignorecase; | |
623 | if ( $c eq '!' ) { | |
624 | $opctl{"no$_"} = $c; | |
625 | $c = ''; | |
626 | } | |
627 | $opctl{$_} = $c; | |
a0d0e21e | 628 | } |
a0d0e21e LW |
629 | if ( defined $a ) { |
630 | # Note alias. | |
631 | $aliases{$_} = $a; | |
632 | } | |
633 | else { | |
634 | # Set primary name. | |
635 | $a = $_; | |
636 | } | |
637 | } | |
381319f7 | 638 | $o = $linko; |
a0d0e21e | 639 | } |
404cbe93 | 640 | |
641 | # If no linkage is supplied in the @optionlist, copy it from | |
642 | # the userlinkage if available. | |
643 | if ( defined $userlinkage ) { | |
644 | unless ( @optionlist > 0 && ref($optionlist[0]) ) { | |
645 | if ( exists $userlinkage->{$o} && ref($userlinkage->{$o}) ) { | |
646 | print STDERR ("=> found userlinkage for \"$o\": ", | |
647 | "$userlinkage->{$o}\n") | |
648 | if $debug; | |
649 | unshift (@optionlist, $userlinkage->{$o}); | |
650 | } | |
651 | else { | |
652 | # Do nothing. Being undefined will be handled later. | |
653 | next; | |
654 | } | |
655 | } | |
656 | } | |
657 | ||
658 | # Copy the linkage. If omitted, link to global variable. | |
659 | if ( @optionlist > 0 && ref($optionlist[0]) ) { | |
660 | print STDERR ("=> link \"$o\" to $optionlist[0]\n") | |
661 | if $debug; | |
381319f7 | 662 | if ( ref($optionlist[0]) =~ /^(SCALAR|CODE)$/ ) { |
404cbe93 | 663 | $linkage{$o} = shift (@optionlist); |
664 | } | |
381319f7 | 665 | elsif ( ref($optionlist[0]) =~ /^(ARRAY)$/ ) { |
666 | $linkage{$o} = shift (@optionlist); | |
667 | $opctl{$o} .= '@' unless $opctl{$o} =~ /\@$/; | |
668 | } | |
669 | elsif ( ref($optionlist[0]) =~ /^(HASH)$/ ) { | |
670 | $linkage{$o} = shift (@optionlist); | |
671 | $opctl{$o} .= '%' unless $opctl{$o} =~ /\%$/; | |
672 | } | |
404cbe93 | 673 | else { |
674 | warn ("Invalid option linkage for \"", $opt, "\"\n"); | |
88e49c4e | 675 | $error++; |
404cbe93 | 676 | } |
677 | } | |
678 | else { | |
679 | # Link to global $opt_XXX variable. | |
680 | # Make sure a valid perl identifier results. | |
681 | my $ov = $o; | |
682 | $ov =~ s/\W/_/g; | |
381319f7 | 683 | if ( $c =~ /@/ ) { |
404cbe93 | 684 | print STDERR ("=> link \"$o\" to \@$pkg","::opt_$ov\n") |
685 | if $debug; | |
686 | eval ("\$linkage{\$o} = \\\@".$pkg."::opt_$ov;"); | |
687 | } | |
381319f7 | 688 | elsif ( $c =~ /%/ ) { |
689 | print STDERR ("=> link \"$o\" to \%$pkg","::opt_$ov\n") | |
690 | if $debug; | |
691 | eval ("\$linkage{\$o} = \\\%".$pkg."::opt_$ov;"); | |
692 | } | |
404cbe93 | 693 | else { |
694 | print STDERR ("=> link \"$o\" to \$$pkg","::opt_$ov\n") | |
695 | if $debug; | |
696 | eval ("\$linkage{\$o} = \\\$".$pkg."::opt_$ov;"); | |
697 | } | |
698 | } | |
a0d0e21e | 699 | } |
a0d0e21e | 700 | |
404cbe93 | 701 | # Bail out if errors found. |
88e49c4e | 702 | return 0 if $error; |
404cbe93 | 703 | |
88e49c4e | 704 | # Sort the possible long option names. |
385588b3 | 705 | local (@opctl) = sort(keys (%opctl)) if $autoabbrev; |
a0d0e21e | 706 | |
88e49c4e | 707 | # Show the options tables if debugging. |
a0d0e21e | 708 | if ( $debug ) { |
404cbe93 | 709 | my ($arrow, $k, $v); |
a0d0e21e LW |
710 | $arrow = "=> "; |
711 | while ( ($k,$v) = each(%opctl) ) { | |
712 | print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n"); | |
713 | $arrow = " "; | |
714 | } | |
88e49c4e | 715 | $arrow = "=> "; |
716 | while ( ($k,$v) = each(%bopctl) ) { | |
717 | print STDERR ($arrow, "\$bopctl{\"$k\"} = \"$v\"\n"); | |
718 | $arrow = " "; | |
719 | } | |
a0d0e21e LW |
720 | } |
721 | ||
385588b3 RM |
722 | local ($opt); # current option |
723 | local ($arg); # current option value, if any | |
724 | local ($array); # current option is array typed | |
725 | local ($hash); # current option is hash typed | |
726 | local ($key); # hash key for a hash option | |
727 | ||
404cbe93 | 728 | # Process argument list |
729 | while ( @ARGV > 0 ) { | |
a0d0e21e | 730 | |
a0d0e21e LW |
731 | #### Get next argument #### |
732 | ||
733 | $opt = shift (@ARGV); | |
a0d0e21e | 734 | $arg = undef; |
381319f7 | 735 | $array = $hash = 0; |
404cbe93 | 736 | print STDERR ("=> option \"", $opt, "\"\n") if $debug; |
a0d0e21e LW |
737 | |
738 | #### Determine what we have #### | |
739 | ||
740 | # Double dash is option list terminator. | |
741 | if ( $opt eq $argend ) { | |
404cbe93 | 742 | # Finish. Push back accumulated arguments and return. |
743 | unshift (@ARGV, @ret) | |
88e49c4e | 744 | if $order == $PERMUTE; |
745 | return ($error == 0); | |
a0d0e21e | 746 | } |
404cbe93 | 747 | |
381319f7 | 748 | my $tryopt = $opt; |
749 | ||
750 | # find_option operates on the GLOBAL $opt and $arg! | |
385588b3 | 751 | if ( &find_option ) { |
381319f7 | 752 | |
753 | # find_option undefines $opt in case of errors. | |
754 | next unless defined $opt; | |
a0d0e21e | 755 | |
381319f7 | 756 | if ( defined $arg ) { |
757 | $opt = $aliases{$opt} if defined $aliases{$opt}; | |
758 | ||
759 | if ( defined $linkage{$opt} ) { | |
760 | print STDERR ("=> ref(\$L{$opt}) -> ", | |
761 | ref($linkage{$opt}), "\n") if $debug; | |
762 | ||
763 | if ( ref($linkage{$opt}) eq 'SCALAR' ) { | |
764 | print STDERR ("=> \$\$L{$opt} = \"$arg\"\n") if $debug; | |
765 | ${$linkage{$opt}} = $arg; | |
766 | } | |
767 | elsif ( ref($linkage{$opt}) eq 'ARRAY' ) { | |
768 | print STDERR ("=> push(\@{\$L{$opt}, \"$arg\")\n") | |
769 | if $debug; | |
770 | push (@{$linkage{$opt}}, $arg); | |
771 | } | |
772 | elsif ( ref($linkage{$opt}) eq 'HASH' ) { | |
773 | print STDERR ("=> \$\$L{$opt}->{$key} = \"$arg\"\n") | |
774 | if $debug; | |
775 | $linkage{$opt}->{$key} = $arg; | |
776 | } | |
777 | elsif ( ref($linkage{$opt}) eq 'CODE' ) { | |
778 | print STDERR ("=> &L{$opt}(\"$opt\", \"$arg\")\n") | |
779 | if $debug; | |
780 | &{$linkage{$opt}}($opt, $arg); | |
781 | } | |
782 | else { | |
783 | print STDERR ("Invalid REF type \"", ref($linkage{$opt}), | |
784 | "\" in linkage\n"); | |
785 | die ("Getopt::Long -- internal error!\n"); | |
786 | } | |
787 | } | |
788 | # No entry in linkage means entry in userlinkage. | |
789 | elsif ( $array ) { | |
790 | if ( defined $userlinkage->{$opt} ) { | |
791 | print STDERR ("=> push(\@{\$L{$opt}}, \"$arg\")\n") | |
792 | if $debug; | |
793 | push (@{$userlinkage->{$opt}}, $arg); | |
794 | } | |
795 | else { | |
796 | print STDERR ("=>\$L{$opt} = [\"$arg\"]\n") | |
797 | if $debug; | |
798 | $userlinkage->{$opt} = [$arg]; | |
799 | } | |
800 | } | |
801 | elsif ( $hash ) { | |
802 | if ( defined $userlinkage->{$opt} ) { | |
803 | print STDERR ("=> \$L{$opt}->{$key} = \"$arg\"\n") | |
804 | if $debug; | |
805 | $userlinkage->{$opt}->{$key} = $arg; | |
806 | } | |
807 | else { | |
808 | print STDERR ("=>\$L{$opt} = {$key => \"$arg\"}\n") | |
809 | if $debug; | |
810 | $userlinkage->{$opt} = {$key => $arg}; | |
811 | } | |
812 | } | |
813 | else { | |
814 | print STDERR ("=>\$L{$opt} = \"$arg\"\n") if $debug; | |
815 | $userlinkage->{$opt} = $arg; | |
816 | } | |
817 | } | |
a0d0e21e | 818 | } |
404cbe93 | 819 | |
820 | # Not an option. Save it if we $PERMUTE and don't have a <>. | |
88e49c4e | 821 | elsif ( $order == $PERMUTE ) { |
404cbe93 | 822 | # Try non-options call-back. |
823 | my $cb; | |
824 | if ( (defined ($cb = $linkage{'<>'})) ) { | |
381319f7 | 825 | &$cb($tryopt); |
404cbe93 | 826 | } |
827 | else { | |
381319f7 | 828 | print STDERR ("=> saving \"$tryopt\" ", |
88e49c4e | 829 | "(not an option, may permute)\n") if $debug; |
381319f7 | 830 | push (@ret, $tryopt); |
404cbe93 | 831 | } |
a0d0e21e LW |
832 | next; |
833 | } | |
404cbe93 | 834 | |
a0d0e21e LW |
835 | # ...otherwise, terminate. |
836 | else { | |
404cbe93 | 837 | # Push this one back and exit. |
381319f7 | 838 | unshift (@ARGV, $tryopt); |
88e49c4e | 839 | return ($error == 0); |
a0d0e21e LW |
840 | } |
841 | ||
381319f7 | 842 | } |
843 | ||
844 | # Finish. | |
845 | if ( $order == $PERMUTE ) { | |
846 | # Push back accumulated arguments | |
847 | print STDERR ("=> restoring \"", join('" "', @ret), "\"\n") | |
848 | if $debug && @ret > 0; | |
849 | unshift (@ARGV, @ret) if @ret > 0; | |
850 | } | |
851 | ||
852 | return ($error == 0); | |
853 | } | |
854 | ||
385588b3 | 855 | sub find_option { |
381319f7 | 856 | |
385588b3 | 857 | return 0 unless $opt =~ /^($genprefix)(.*)/s; |
381319f7 | 858 | |
385588b3 RM |
859 | $opt = $+; |
860 | my ($starter) = $1; | |
381319f7 | 861 | |
862 | my $optarg = undef; # value supplied with --opt=value | |
863 | my $rest = undef; # remainder from unbundling | |
864 | ||
865 | # If it is a long option, it may include the value. | |
866 | if (($starter eq "--" || $getopt_compat) | |
385588b3 | 867 | && $opt =~ /^([^=]+)=(.*)/s ) { |
381319f7 | 868 | $opt = $1; |
385588b3 | 869 | $optarg = $2; |
381319f7 | 870 | print STDERR ("=> option \"", $opt, |
871 | "\", optarg = \"$optarg\"\n") if $debug; | |
872 | } | |
873 | ||
874 | #### Look it up ### | |
875 | ||
876 | my $tryopt = $opt; # option to try | |
877 | my $optbl = \%opctl; # table to look it up (long names) | |
878 | ||
879 | if ( $bundling && $starter eq '-' ) { | |
880 | # Unbundle single letter option. | |
881 | $rest = substr ($tryopt, 1); | |
882 | $tryopt = substr ($tryopt, 0, 1); | |
883 | $tryopt = lc ($tryopt) if $ignorecase > 1; | |
884 | print STDERR ("=> $starter$tryopt unbundled from ", | |
885 | "$starter$tryopt$rest\n") if $debug; | |
886 | $rest = undef unless $rest ne ''; | |
887 | $optbl = \%bopctl; # look it up in the short names table | |
888 | } | |
889 | ||
890 | # Try auto-abbreviation. | |
891 | elsif ( $autoabbrev ) { | |
892 | # Downcase if allowed. | |
893 | $tryopt = $opt = lc ($opt) if $ignorecase; | |
894 | # Turn option name into pattern. | |
895 | my $pat = quotemeta ($opt); | |
896 | # Look up in option names. | |
897 | my @hits = grep (/^$pat/, @opctl); | |
898 | print STDERR ("=> ", scalar(@hits), " hits (@hits) with \"$pat\" ", | |
899 | "out of ", scalar(@opctl), "\n") if $debug; | |
900 | ||
901 | # Check for ambiguous results. | |
902 | unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { | |
903 | # See if all matches are for the same option. | |
904 | my %hit; | |
905 | foreach ( @hits ) { | |
906 | $_ = $aliases{$_} if defined $aliases{$_}; | |
907 | $hit{$_} = 1; | |
908 | } | |
909 | # Now see if it really is ambiguous. | |
910 | unless ( keys(%hit) == 1 ) { | |
911 | return 0 if $passthrough; | |
a0d0e21e LW |
912 | print STDERR ("Option ", $opt, " is ambiguous (", |
913 | join(", ", @hits), ")\n"); | |
88e49c4e | 914 | $error++; |
381319f7 | 915 | undef $opt; |
916 | return 1; | |
a0d0e21e | 917 | } |
381319f7 | 918 | @hits = keys(%hit); |
a0d0e21e LW |
919 | } |
920 | ||
381319f7 | 921 | # Complete the option name, if appropriate. |
922 | if ( @hits == 1 && $hits[0] ne $opt ) { | |
923 | $tryopt = $hits[0]; | |
924 | $tryopt = lc ($tryopt) if $ignorecase; | |
925 | print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") | |
926 | if $debug; | |
a0d0e21e | 927 | } |
381319f7 | 928 | } |
a0d0e21e | 929 | |
16c18a90 JV |
930 | # Map to all lowercase if ignoring case. |
931 | elsif ( $ignorecase ) { | |
932 | $tryopt = lc ($opt); | |
933 | } | |
934 | ||
381319f7 | 935 | # Check validity by fetching the info. |
385588b3 | 936 | my $type = $optbl->{$tryopt}; |
381319f7 | 937 | unless ( defined $type ) { |
938 | return 0 if $passthrough; | |
939 | warn ("Unknown option: ", $opt, "\n"); | |
940 | $error++; | |
941 | return 1; | |
942 | } | |
943 | # Apparently valid. | |
944 | $opt = $tryopt; | |
945 | print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug; | |
a0d0e21e | 946 | |
381319f7 | 947 | #### Determine argument status #### |
a0d0e21e | 948 | |
381319f7 | 949 | # If it is an option w/o argument, we're almost finished with it. |
950 | if ( $type eq '' || $type eq '!' ) { | |
951 | if ( defined $optarg ) { | |
952 | return 0 if $passthrough; | |
953 | print STDERR ("Option ", $opt, " does not take an argument\n"); | |
954 | $error++; | |
955 | undef $opt; | |
956 | } | |
957 | elsif ( $type eq '' ) { | |
958 | $arg = 1; # supply explicit value | |
959 | } | |
960 | else { | |
961 | substr ($opt, 0, 2) = ''; # strip NO prefix | |
962 | $arg = 0; # supply explicit value | |
963 | } | |
964 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
965 | return 1; | |
966 | } | |
a0d0e21e | 967 | |
381319f7 | 968 | # Get mandatory status and type info. |
969 | my $mand; | |
970 | ($mand, $type, $array, $hash) = $type =~ /^(.)(.)(@?)(%?)$/; | |
971 | ||
972 | # Check if there is an option argument available. | |
973 | if ( defined $optarg ? ($optarg eq '') | |
974 | : !(defined $rest || @ARGV > 0) ) { | |
975 | # Complain if this option needs an argument. | |
976 | if ( $mand eq "=" ) { | |
977 | return 0 if $passthrough; | |
978 | print STDERR ("Option ", $opt, " requires an argument\n"); | |
979 | $error++; | |
980 | undef $opt; | |
981 | } | |
982 | if ( $mand eq ":" ) { | |
983 | $arg = $type eq "s" ? '' : 0; | |
a0d0e21e | 984 | } |
381319f7 | 985 | return 1; |
986 | } | |
a0d0e21e | 987 | |
381319f7 | 988 | # Get (possibly optional) argument. |
989 | $arg = (defined $rest ? $rest | |
990 | : (defined $optarg ? $optarg : shift (@ARGV))); | |
a0d0e21e | 991 | |
381319f7 | 992 | # Get key if this is a "name=value" pair for a hash option. |
993 | $key = undef; | |
994 | if ($hash && defined $arg) { | |
385588b3 | 995 | ($key, $arg) = ($arg =~ /(.*?)=(.*)/s) ? ($1, $2) : ($arg, 1); |
381319f7 | 996 | } |
a0d0e21e | 997 | |
381319f7 | 998 | #### Check if the argument is valid for this option #### |
a0d0e21e | 999 | |
381319f7 | 1000 | if ( $type eq "s" ) { # string |
1001 | # A mandatory string takes anything. | |
1002 | return 1 if $mand eq "="; | |
a0d0e21e | 1003 | |
381319f7 | 1004 | # An optional string takes almost anything. |
1005 | return 1 if defined $optarg || defined $rest; | |
1006 | return 1 if $arg eq "-"; # ?? | |
a0d0e21e | 1007 | |
381319f7 | 1008 | # Check for option or option list terminator. |
1009 | if ($arg eq $argend || | |
1010 | $arg =~ /^$genprefix.+/) { | |
1011 | # Push back. | |
1012 | unshift (@ARGV, $arg); | |
1013 | # Supply empty value. | |
1014 | $arg = ''; | |
a0d0e21e | 1015 | } |
381319f7 | 1016 | } |
a0d0e21e | 1017 | |
381319f7 | 1018 | elsif ( $type eq "n" || $type eq "i" ) { # numeric/integer |
1019 | if ( $arg !~ /^-?[0-9]+$/ ) { | |
1020 | if ( defined $optarg || $mand eq "=" ) { | |
1021 | return 0 if $passthrough; | |
1022 | print STDERR ("Value \"", $arg, "\" invalid for option ", | |
1023 | $opt, " (number expected)\n"); | |
1024 | $error++; | |
1025 | undef $opt; | |
1026 | # Push back. | |
1027 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
1028 | } | |
1029 | else { | |
1030 | # Push back. | |
1031 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
1032 | # Supply default value. | |
1033 | $arg = 0; | |
a0d0e21e | 1034 | } |
a0d0e21e | 1035 | } |
a0d0e21e LW |
1036 | } |
1037 | ||
381319f7 | 1038 | elsif ( $type eq "f" ) { # real number, int is also ok |
1039 | if ( $arg !~ /^-?[0-9.]+([eE]-?[0-9]+)?$/ ) { | |
1040 | if ( defined $optarg || $mand eq "=" ) { | |
1041 | return 0 if $passthrough; | |
1042 | print STDERR ("Value \"", $arg, "\" invalid for option ", | |
1043 | $opt, " (real number expected)\n"); | |
1044 | $error++; | |
1045 | undef $opt; | |
1046 | # Push back. | |
1047 | unshift (@ARGV, $starter.$rest) if defined $rest; | |
a0d0e21e LW |
1048 | } |
1049 | else { | |
381319f7 | 1050 | # Push back. |
1051 | unshift (@ARGV, defined $rest ? $starter.$rest : $arg); | |
1052 | # Supply default value. | |
1053 | $arg = 0.0; | |
a0d0e21e LW |
1054 | } |
1055 | } | |
1056 | } | |
381319f7 | 1057 | else { |
1058 | die ("GetOpt::Long internal error (Can't happen)\n"); | |
a0d0e21e | 1059 | } |
381319f7 | 1060 | return 1; |
385588b3 | 1061 | } |
a0d0e21e LW |
1062 | |
1063 | ################ Package return ################ | |
1064 | ||
88e49c4e | 1065 | 1; |