← Index
NYTProf Performance Profile   « line view »
For bin/benchmark-perlformance
  Run on Fri Apr 17 15:31:48 2015
Reported on Fri Apr 17 15:32:02 2015

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