← Index
NYTProf Performance Profile   « block view • line view • sub view »
For bin/pan_genome_post_analysis
  Run on Fri Mar 27 11:43:32 2015
Reported on Fri Mar 27 11:45:41 2015

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