Commit | Line | Data |
a0d0e21e |
1 | package Getopt::Std; |
2 | require 5.000; |
3 | require Exporter; |
4 | |
f06db76b |
5 | =head1 NAME |
6 | |
7 | getopt - Process single-character switches with switch clustering |
8 | |
9 | getopts - Process single-character switches with switch clustering |
10 | |
11 | =head1 SYNOPSIS |
12 | |
13 | use Getopt::Std; |
0bc14741 |
14 | |
12527e6c |
15 | getopt('oDI'); # -o, -D & -I take arg. Sets $opt_* as a side effect. |
0bc14741 |
16 | getopt('oDI', \%opts); # -o, -D & -I take arg. Values in %opts |
f06db76b |
17 | getopts('oif:'); # -o & -i are boolean flags, -f takes an argument |
12527e6c |
18 | # Sets $opt_* as a side effect. |
0bc14741 |
19 | getopts('oif:', \%opts); # options as above. Values in %opts |
f06db76b |
20 | |
21 | =head1 DESCRIPTION |
22 | |
12527e6c |
23 | The getopt() function processes single-character switches with switch |
f06db76b |
24 | clustering. Pass one argument which is a string containing all switches |
25 | that take an argument. For each switch found, sets $opt_x (where x is the |
26 | switch name) to the value of the argument, or 1 if no argument. Switches |
27 | which take an argument don't care whether there is a space between the |
28 | switch and the argument. |
29 | |
12527e6c |
30 | The getopts() function is similar, but you should pass to it the list of all |
31 | switches to be recognized. If unspecified switches are found on the |
32 | command-line, the user will be warned that an unknown option was given. |
33 | |
535b5725 |
34 | Note that, if your code is running under the recommended C<use strict |
5812d790 |
35 | 'vars'> pragma, you will need to declare these package variables |
36 | with "our": |
535b5725 |
37 | |
12527e6c |
38 | our($opt_x, $opt_y); |
535b5725 |
39 | |
5812d790 |
40 | For those of you who don't like additional global variables being created, getopt() |
0bc14741 |
41 | and getopts() will also accept a hash reference as an optional second argument. |
42 | Hash keys will be x (where x is the switch name) with key values the value of |
43 | the argument or 1 if no argument is specified. |
44 | |
5812d790 |
45 | To allow programs to process arguments that look like switches, but aren't, |
46 | both functions will stop processing switches when they see the argument |
47 | C<-->. The C<--> will be removed from @ARGV. |
48 | |
f06db76b |
49 | =cut |
50 | |
a0d0e21e |
51 | @ISA = qw(Exporter); |
52 | @EXPORT = qw(getopt getopts); |
12527e6c |
53 | $VERSION = '1.03'; |
a0d0e21e |
54 | |
55 | # Process single-character switches with switch clustering. Pass one argument |
56 | # which is a string containing all switches that take an argument. For each |
57 | # switch found, sets $opt_x (where x is the switch name) to the value of the |
58 | # argument, or 1 if no argument. Switches which take an argument don't care |
59 | # whether there is a space between the switch and the argument. |
60 | |
61 | # Usage: |
62 | # getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. |
63 | |
12527e6c |
64 | sub getopt (;$$) { |
65 | my ($argumentative, $hash) = @_; |
66 | $argumentative = '' if !defined $argumentative; |
67 | my ($first,$rest); |
68 | local $_; |
6ca64377 |
69 | local @EXPORT; |
a0d0e21e |
70 | |
71 | while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
72 | ($first,$rest) = ($1,$2); |
5812d790 |
73 | if (/^--$/) { # early exit if -- |
74 | shift @ARGV; |
75 | last; |
76 | } |
a0d0e21e |
77 | if (index($argumentative,$first) >= 0) { |
78 | if ($rest ne '') { |
79 | shift(@ARGV); |
80 | } |
81 | else { |
82 | shift(@ARGV); |
83 | $rest = shift(@ARGV); |
84 | } |
5812d790 |
85 | if (ref $hash) { |
86 | $$hash{$first} = $rest; |
87 | } |
88 | else { |
89 | ${"opt_$first"} = $rest; |
90 | push( @EXPORT, "\$opt_$first" ); |
91 | } |
a0d0e21e |
92 | } |
93 | else { |
5812d790 |
94 | if (ref $hash) { |
95 | $$hash{$first} = 1; |
96 | } |
97 | else { |
98 | ${"opt_$first"} = 1; |
99 | push( @EXPORT, "\$opt_$first" ); |
100 | } |
a0d0e21e |
101 | if ($rest ne '') { |
102 | $ARGV[0] = "-$rest"; |
103 | } |
104 | else { |
105 | shift(@ARGV); |
106 | } |
107 | } |
108 | } |
6ca64377 |
109 | unless (ref $hash) { |
110 | local $Exporter::ExportLevel = 1; |
111 | import Getopt::Std; |
112 | } |
a0d0e21e |
113 | } |
114 | |
115 | # Usage: |
116 | # getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a |
117 | # # side effect. |
118 | |
0bc14741 |
119 | sub getopts ($;$) { |
12527e6c |
120 | my ($argumentative, $hash) = @_; |
121 | my (@args,$first,$rest); |
122 | my $errs = 0; |
123 | local $_; |
6ca64377 |
124 | local @EXPORT; |
a0d0e21e |
125 | |
126 | @args = split( / */, $argumentative ); |
127 | while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
128 | ($first,$rest) = ($1,$2); |
5812d790 |
129 | if (/^--$/) { # early exit if -- |
130 | shift @ARGV; |
131 | last; |
132 | } |
a0d0e21e |
133 | $pos = index($argumentative,$first); |
5812d790 |
134 | if ($pos >= 0) { |
135 | if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) { |
a0d0e21e |
136 | shift(@ARGV); |
5812d790 |
137 | if ($rest eq '') { |
a0d0e21e |
138 | ++$errs unless @ARGV; |
139 | $rest = shift(@ARGV); |
140 | } |
5812d790 |
141 | if (ref $hash) { |
142 | $$hash{$first} = $rest; |
143 | } |
144 | else { |
145 | ${"opt_$first"} = $rest; |
146 | push( @EXPORT, "\$opt_$first" ); |
147 | } |
a0d0e21e |
148 | } |
149 | else { |
5812d790 |
150 | if (ref $hash) { |
151 | $$hash{$first} = 1; |
152 | } |
153 | else { |
154 | ${"opt_$first"} = 1; |
155 | push( @EXPORT, "\$opt_$first" ); |
156 | } |
157 | if ($rest eq '') { |
a0d0e21e |
158 | shift(@ARGV); |
159 | } |
160 | else { |
161 | $ARGV[0] = "-$rest"; |
162 | } |
163 | } |
164 | } |
165 | else { |
55118cb0 |
166 | warn "Unknown option: $first\n"; |
a0d0e21e |
167 | ++$errs; |
5812d790 |
168 | if ($rest ne '') { |
a0d0e21e |
169 | $ARGV[0] = "-$rest"; |
170 | } |
171 | else { |
172 | shift(@ARGV); |
173 | } |
174 | } |
175 | } |
6ca64377 |
176 | unless (ref $hash) { |
177 | local $Exporter::ExportLevel = 1; |
178 | import Getopt::Std; |
179 | } |
a0d0e21e |
180 | $errs == 0; |
181 | } |
182 | |
183 | 1; |