Line | |
---|
1 | ;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
|
---|
2 | #
|
---|
3 | # This library is no longer being maintained, and is included for backward
|
---|
4 | # compatibility with Perl 4 programs which may require it.
|
---|
5 | #
|
---|
6 | # In particular, this should not be used as an example of modern Perl
|
---|
7 | # programming techniques.
|
---|
8 | #
|
---|
9 | # Suggested alternatives: Getopt::Long or Getopt::Std
|
---|
10 | #
|
---|
11 | ;# Process single-character switches with switch clustering. Pass one argument
|
---|
12 | ;# which is a string containing all switches that take an argument. For each
|
---|
13 | ;# switch found, sets $opt_x (where x is the switch name) to the value of the
|
---|
14 | ;# argument, or 1 if no argument. Switches which take an argument don't care
|
---|
15 | ;# whether there is a space between the switch and the argument.
|
---|
16 |
|
---|
17 | ;# Usage:
|
---|
18 | ;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
|
---|
19 |
|
---|
20 | sub Getopt {
|
---|
21 | local($argumentative) = @_;
|
---|
22 | local($_,$first,$rest);
|
---|
23 | local($[) = 0;
|
---|
24 |
|
---|
25 | while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
|
---|
26 | ($first,$rest) = ($1,$2);
|
---|
27 | if (index($argumentative,$first) >= $[) {
|
---|
28 | if ($rest ne '') {
|
---|
29 | shift(@ARGV);
|
---|
30 | }
|
---|
31 | else {
|
---|
32 | shift(@ARGV);
|
---|
33 | $rest = shift(@ARGV);
|
---|
34 | }
|
---|
35 | ${"opt_$first"} = $rest;
|
---|
36 | }
|
---|
37 | else {
|
---|
38 | ${"opt_$first"} = 1;
|
---|
39 | if ($rest ne '') {
|
---|
40 | $ARGV[0] = "-$rest";
|
---|
41 | }
|
---|
42 | else {
|
---|
43 | shift(@ARGV);
|
---|
44 | }
|
---|
45 | }
|
---|
46 | }
|
---|
47 | }
|
---|
48 |
|
---|
49 | 1;
|
---|
Note:
See
TracBrowser
for help on using the repository browser.