← Index
NYTProf Performance Profile   « line view »
For ../prof.pl
  Run on Wed Dec 14 16:10:05 2022
Reported on Wed Dec 14 16:12:57 2022

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