Revision 14545,
1.2 KB
checked in by ghudson, 24 years ago
(diff) |
This commit was generated by cvs2svn to compensate for changes in r14544,
which included commits to RCS files with non-trunk default branches.
|
Line | |
---|
1 | ;# getopts.pl - a better getopt.pl |
---|
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 | ;# Usage: |
---|
12 | ;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a |
---|
13 | ;# # side effect. |
---|
14 | |
---|
15 | sub Getopts { |
---|
16 | local($argumentative) = @_; |
---|
17 | local(@args,$_,$first,$rest); |
---|
18 | local($errs) = 0; |
---|
19 | |
---|
20 | @args = split( / */, $argumentative ); |
---|
21 | while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
---|
22 | ($first,$rest) = ($1,$2); |
---|
23 | $pos = index($argumentative,$first); |
---|
24 | if($pos >= 0) { |
---|
25 | if($pos < $#args && $args[$pos+1] eq ':') { |
---|
26 | shift(@ARGV); |
---|
27 | if($rest eq '') { |
---|
28 | ++$errs unless @ARGV; |
---|
29 | $rest = shift(@ARGV); |
---|
30 | } |
---|
31 | ${"opt_$first"} = $rest; |
---|
32 | } |
---|
33 | else { |
---|
34 | ${"opt_$first"} = 1; |
---|
35 | if($rest eq '') { |
---|
36 | shift(@ARGV); |
---|
37 | } |
---|
38 | else { |
---|
39 | $ARGV[0] = "-$rest"; |
---|
40 | } |
---|
41 | } |
---|
42 | } |
---|
43 | else { |
---|
44 | print STDERR "Unknown option: $first\n"; |
---|
45 | ++$errs; |
---|
46 | if($rest ne '') { |
---|
47 | $ARGV[0] = "-$rest"; |
---|
48 | } |
---|
49 | else { |
---|
50 | shift(@ARGV); |
---|
51 | } |
---|
52 | } |
---|
53 | } |
---|
54 | $errs == 0; |
---|
55 | } |
---|
56 | |
---|
57 | 1; |
---|
Note: See
TracBrowser
for help on using the repository browser.