This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Getopt::Std: Changed pod NAME to follow convention
[perl5.git] / lib / Getopt / Std.pm
CommitLineData
a0d0e21e
LW
1package Getopt::Std;
2require 5.000;
3require Exporter;
4
f06db76b
AD
5=head1 NAME
6
61f45fbe 7Getopt::Std - Process single-character switches with switch clustering
f06db76b
AD
8
9=head1 SYNOPSIS
10
11 use Getopt::Std;
0bc14741 12
f06db76b 13 getopts('oif:'); # -o & -i are boolean flags, -f takes an argument
12527e6c 14 # Sets $opt_* as a side effect.
0bc14741 15 getopts('oif:', \%opts); # options as above. Values in %opts
555bd962
BG
16 getopt('oDI'); # -o, -D & -I take arg.
17 # Sets $opt_* as a side effect.
0c0a84c6 18 getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts
f06db76b
AD
19
20=head1 DESCRIPTION
21
243ac78f
JK
22The C<getopts()> function processes single-character switches with switch
23clustering. Pass one argument which is a string containing all switches to be
24recognized. For each switch found, if an argument is expected and provided,
25C<getopts()> sets C<$opt_x> (where C<x> is the switch name) to the value of
26the argument. If an argument is expected but none is provided, C<$opt_x> is
27set to an undefined value. If a switch does not take an argument, C<$opt_x>
28is set to C<1>.
29
30Switches which take an argument don't care whether there is a space between
31the switch and the argument. If unspecified switches are found on the
32command-line, the user will be warned that an unknown option was given.
33
34The C<getopts()> function returns true unless an invalid option was found.
35
36The C<getopt()> function is similar, but its argument is a string containing
37all switches that take an argument. If no argument is provided for a switch,
38say, C<y>, the corresponding C<$opt_y> will be set to an undefined value.
624c6f90
JK
39Unspecified switches are silently accepted. Use of C<getopt()> is not
40recommended.
12527e6c 41
535b5725 42Note that, if your code is running under the recommended C<use strict
243ac78f
JK
43vars> pragma, you will need to declare these package variables
44with C<our>:
535b5725 45
12527e6c 46 our($opt_x, $opt_y);
535b5725 47
243ac78f
JK
48For those of you who don't like additional global variables being created,
49C<getopt()> and C<getopts()> will also accept a hash reference as an optional
50second argument. Hash keys will be C<x> (where C<x> is the switch name) with
51key values the value of the argument or C<1> if no argument is specified.
0bc14741 52
5812d790
GS
53To allow programs to process arguments that look like switches, but aren't,
54both functions will stop processing switches when they see the argument
55C<-->. The C<--> will be removed from @ARGV.
56
294d099e
IZ
57=head1 C<--help> and C<--version>
58
59If C<-> is not a recognized switch letter, getopts() supports arguments
60C<--help> and C<--version>. If C<main::HELP_MESSAGE()> and/or
61C<main::VERSION_MESSAGE()> are defined, they are called; the arguments are
62the output file handle, the name of option-processing package, its version,
63and the switches string. If the subroutines are not defined, an attempt is
64made to generate intelligent messages; for best results, define $main::VERSION.
65
669ecdbc
IZ
66If embedded documentation (in pod format, see L<perlpod>) is detected
67in the script, C<--help> will also show how to access the documentation.
68
294d099e
IZ
69Note that due to excessive paranoia, if $Getopt::Std::STANDARD_HELP_VERSION
70isn't true (the default is false), then the messages are printed on STDERR,
71and the processing continues after the messages are printed. This being
72the opposite of the standard-conforming behaviour, it is strongly recommended
73to set $Getopt::Std::STANDARD_HELP_VERSION to true.
74
75One can change the output file handle of the messages by setting
76$Getopt::Std::OUTPUT_HELP_VERSION. One can print the messages of C<--help>
77(without the C<Usage:> line) and C<--version> by calling functions help_mess()
78and version_mess() with the switches string as an argument.
79
f06db76b
AD
80=cut
81
a0d0e21e
LW
82@ISA = qw(Exporter);
83@EXPORT = qw(getopt getopts);
61f45fbe 84$VERSION = '1.12';
294d099e
IZ
85# uncomment the next line to disable 1.03-backward compatibility paranoia
86# $STANDARD_HELP_VERSION = 1;
a0d0e21e
LW
87
88# Process single-character switches with switch clustering. Pass one argument
89# which is a string containing all switches that take an argument. For each
90# switch found, sets $opt_x (where x is the switch name) to the value of the
91# argument, or 1 if no argument. Switches which take an argument don't care
92# whether there is a space between the switch and the argument.
93
94# Usage:
95# getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
96
12527e6c
RGS
97sub getopt (;$$) {
98 my ($argumentative, $hash) = @_;
99 $argumentative = '' if !defined $argumentative;
100 my ($first,$rest);
101 local $_;
6ca64377 102 local @EXPORT;
a0d0e21e
LW
103
104 while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
105 ($first,$rest) = ($1,$2);
5812d790
GS
106 if (/^--$/) { # early exit if --
107 shift @ARGV;
108 last;
109 }
a0d0e21e
LW
110 if (index($argumentative,$first) >= 0) {
111 if ($rest ne '') {
112 shift(@ARGV);
113 }
114 else {
115 shift(@ARGV);
116 $rest = shift(@ARGV);
117 }
5812d790
GS
118 if (ref $hash) {
119 $$hash{$first} = $rest;
120 }
121 else {
122 ${"opt_$first"} = $rest;
123 push( @EXPORT, "\$opt_$first" );
124 }
a0d0e21e
LW
125 }
126 else {
5812d790
GS
127 if (ref $hash) {
128 $$hash{$first} = 1;
129 }
130 else {
131 ${"opt_$first"} = 1;
132 push( @EXPORT, "\$opt_$first" );
133 }
a0d0e21e
LW
134 if ($rest ne '') {
135 $ARGV[0] = "-$rest";
136 }
137 else {
138 shift(@ARGV);
139 }
140 }
141 }
6ca64377
RB
142 unless (ref $hash) {
143 local $Exporter::ExportLevel = 1;
144 import Getopt::Std;
145 }
a0d0e21e
LW
146}
147
294d099e
IZ
148sub output_h () {
149 return $OUTPUT_HELP_VERSION if defined $OUTPUT_HELP_VERSION;
150 return \*STDOUT if $STANDARD_HELP_VERSION;
151 return \*STDERR;
152}
153
154sub try_exit () {
155 exit 0 if $STANDARD_HELP_VERSION;
156 my $p = __PACKAGE__;
157 print {output_h()} <<EOM;
158 [Now continuing due to backward compatibility and excessive paranoia.
1f874cb6 159 See 'perldoc $p' about \$$p\::STANDARD_HELP_VERSION.]
294d099e
IZ
160EOM
161}
162
163sub version_mess ($;$) {
164 my $args = shift;
165 my $h = output_h;
166 if (@_ and defined &main::VERSION_MESSAGE) {
167 main::VERSION_MESSAGE($h, __PACKAGE__, $VERSION, $args);
168 } else {
169 my $v = $main::VERSION;
170 $v = '[unknown]' unless defined $v;
171 my $myv = $VERSION;
172 $myv .= ' [paranoid]' unless $STANDARD_HELP_VERSION;
173 my $perlv = $];
174 $perlv = sprintf "%vd", $^V if $] >= 5.006;
175 print $h <<EOH;
176$0 version $v calling Getopt::Std::getopts (version $myv),
177running under Perl version $perlv.
178EOH
179 }
180}
181
182sub help_mess ($;$) {
183 my $args = shift;
184 my $h = output_h;
185 if (@_ and defined &main::HELP_MESSAGE) {
186 main::HELP_MESSAGE($h, __PACKAGE__, $VERSION, $args);
187 } else {
188 my (@witharg) = ($args =~ /(\S)\s*:/g);
189 my (@rest) = ($args =~ /([^\s:])(?!\s*:)/g);
190 my ($help, $arg) = ('', '');
191 if (@witharg) {
192 $help .= "\n\tWith arguments: -" . join " -", @witharg;
193 $arg = "\nSpace is not required between options and their arguments.";
194 }
195 if (@rest) {
196 $help .= "\n\tBoolean (without arguments): -" . join " -", @rest;
197 }
198 my ($scr) = ($0 =~ m,([^/\\]+)$,);
199 print $h <<EOH if @_; # Let the script override this
669ecdbc 200
294d099e
IZ
201Usage: $scr [-OPTIONS [-MORE_OPTIONS]] [--] [PROGRAM_ARG1 ...]
202EOH
203 print $h <<EOH;
669ecdbc 204
294d099e 205The following single-character options are accepted:$help
669ecdbc 206
294d099e
IZ
207Options may be merged together. -- stops processing of options.$arg
208EOH
669ecdbc
IZ
209 my $has_pod;
210 if ( defined $0 and $0 ne '-e' and -f $0 and -r $0
211 and open my $script, '<', $0 ) {
212 while (<$script>) {
213 $has_pod = 1, last if /^=(pod|head1)/;
214 }
215 }
216 print $h <<EOH if $has_pod;
217
218For more details run
219 perldoc -F $0
220EOH
294d099e
IZ
221 }
222}
223
a0d0e21e
LW
224# Usage:
225# getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
226# # side effect.
227
0bc14741 228sub getopts ($;$) {
12527e6c 229 my ($argumentative, $hash) = @_;
294d099e 230 my (@args,$first,$rest,$exit);
12527e6c
RGS
231 my $errs = 0;
232 local $_;
6ca64377 233 local @EXPORT;
a0d0e21e
LW
234
235 @args = split( / */, $argumentative );
294d099e 236 while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/s) {
a0d0e21e 237 ($first,$rest) = ($1,$2);
5812d790
GS
238 if (/^--$/) { # early exit if --
239 shift @ARGV;
240 last;
241 }
294d099e 242 my $pos = index($argumentative,$first);
5812d790
GS
243 if ($pos >= 0) {
244 if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
a0d0e21e 245 shift(@ARGV);
5812d790 246 if ($rest eq '') {
a0d0e21e
LW
247 ++$errs unless @ARGV;
248 $rest = shift(@ARGV);
249 }
5812d790
GS
250 if (ref $hash) {
251 $$hash{$first} = $rest;
252 }
253 else {
254 ${"opt_$first"} = $rest;
255 push( @EXPORT, "\$opt_$first" );
256 }
a0d0e21e
LW
257 }
258 else {
5812d790
GS
259 if (ref $hash) {
260 $$hash{$first} = 1;
261 }
262 else {
263 ${"opt_$first"} = 1;
264 push( @EXPORT, "\$opt_$first" );
265 }
266 if ($rest eq '') {
a0d0e21e
LW
267 shift(@ARGV);
268 }
269 else {
270 $ARGV[0] = "-$rest";
271 }
272 }
273 }
274 else {
294d099e
IZ
275 if ($first eq '-' and $rest eq 'help') {
276 version_mess($argumentative, 'main');
277 help_mess($argumentative, 'main');
278 try_exit();
279 shift(@ARGV);
280 next;
281 } elsif ($first eq '-' and $rest eq 'version') {
282 version_mess($argumentative, 'main');
283 try_exit();
284 shift(@ARGV);
285 next;
286 }
55118cb0 287 warn "Unknown option: $first\n";
a0d0e21e 288 ++$errs;
5812d790 289 if ($rest ne '') {
a0d0e21e
LW
290 $ARGV[0] = "-$rest";
291 }
292 else {
293 shift(@ARGV);
294 }
295 }
296 }
6ca64377
RB
297 unless (ref $hash) {
298 local $Exporter::ExportLevel = 1;
299 import Getopt::Std;
300 }
a0d0e21e
LW
301 $errs == 0;
302}
303
3041;