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 | |
15 | getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. |
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 |
18 | # Sets opt_* as a side effect. |
0bc14741 |
19 | getopts('oif:', \%opts); # options as above. Values in %opts |
f06db76b |
20 | |
21 | =head1 DESCRIPTION |
22 | |
23 | The getopt() functions processes single-character switches with switch |
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 | |
0bc14741 |
30 | For those of you who don't like additional variables being created, getopt() |
31 | and getopts() will also accept a hash reference as an optional second argument. |
32 | Hash keys will be x (where x is the switch name) with key values the value of |
33 | the argument or 1 if no argument is specified. |
34 | |
f06db76b |
35 | =cut |
36 | |
a0d0e21e |
37 | @ISA = qw(Exporter); |
38 | @EXPORT = qw(getopt getopts); |
39 | |
40 | # $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $ |
41 | |
42 | # Process single-character switches with switch clustering. Pass one argument |
43 | # which is a string containing all switches that take an argument. For each |
44 | # switch found, sets $opt_x (where x is the switch name) to the value of the |
45 | # argument, or 1 if no argument. Switches which take an argument don't care |
46 | # whether there is a space between the switch and the argument. |
47 | |
48 | # Usage: |
49 | # getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. |
50 | |
0bc14741 |
51 | sub getopt ($;$) { |
52 | local($argumentative, $hash) = @_; |
a0d0e21e |
53 | local($_,$first,$rest); |
54 | local $Exporter::ExportLevel; |
55 | |
56 | while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
57 | ($first,$rest) = ($1,$2); |
58 | if (index($argumentative,$first) >= 0) { |
59 | if ($rest ne '') { |
60 | shift(@ARGV); |
61 | } |
62 | else { |
63 | shift(@ARGV); |
64 | $rest = shift(@ARGV); |
65 | } |
0bc14741 |
66 | if (ref $hash) { |
67 | $$hash{$first} = $rest; |
68 | } |
69 | else { |
70 | eval "\$opt_$first = \$rest;"; |
71 | push( @EXPORT, "\$opt_$first" ); |
72 | } |
a0d0e21e |
73 | } |
74 | else { |
0bc14741 |
75 | if (ref $hash) { |
76 | $$hash{$first} = 1; |
77 | } |
78 | else { |
79 | eval "\$opt_$first = 1;"; |
80 | push( @EXPORT, "\$opt_$first" ); |
81 | } |
a0d0e21e |
82 | if ($rest ne '') { |
83 | $ARGV[0] = "-$rest"; |
84 | } |
85 | else { |
86 | shift(@ARGV); |
87 | } |
88 | } |
89 | } |
90 | $Exporter::ExportLevel++; |
91 | import Getopt::Std; |
92 | } |
93 | |
94 | # Usage: |
95 | # getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a |
96 | # # side effect. |
97 | |
0bc14741 |
98 | sub getopts ($;$) { |
99 | local($argumentative, $hash) = @_; |
a0d0e21e |
100 | local(@args,$_,$first,$rest); |
101 | local($errs) = 0; |
102 | local $Exporter::ExportLevel; |
103 | |
104 | @args = split( / */, $argumentative ); |
105 | while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
106 | ($first,$rest) = ($1,$2); |
107 | $pos = index($argumentative,$first); |
108 | if($pos >= 0) { |
f06db76b |
109 | if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) { |
a0d0e21e |
110 | shift(@ARGV); |
111 | if($rest eq '') { |
112 | ++$errs unless @ARGV; |
113 | $rest = shift(@ARGV); |
114 | } |
0bc14741 |
115 | if (ref $hash) { |
116 | $$hash{$first} = $rest; |
117 | } |
118 | else { |
119 | eval "\$opt_$first = \$rest;"; |
120 | push( @EXPORT, "\$opt_$first" ); |
121 | } |
a0d0e21e |
122 | } |
123 | else { |
0bc14741 |
124 | if (ref $hash) { |
125 | $$hash{$first} = 1; |
126 | } |
127 | else { |
128 | eval "\$opt_$first = 1"; |
129 | push( @EXPORT, "\$opt_$first" ); |
130 | } |
a0d0e21e |
131 | if($rest eq '') { |
132 | shift(@ARGV); |
133 | } |
134 | else { |
135 | $ARGV[0] = "-$rest"; |
136 | } |
137 | } |
138 | } |
139 | else { |
140 | print STDERR "Unknown option: $first\n"; |
141 | ++$errs; |
142 | if($rest ne '') { |
143 | $ARGV[0] = "-$rest"; |
144 | } |
145 | else { |
146 | shift(@ARGV); |
147 | } |
148 | } |
149 | } |
150 | $Exporter::ExportLevel++; |
151 | import Getopt::Std; |
152 | $errs == 0; |
153 | } |
154 | |
155 | 1; |
156 | |