← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:25 2013

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