Commit | Line | Data |
---|---|---|
a687059c | 1 | ;# getopts.pl - a better getopt.pl |
a6d71656 | 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 | # | |
a687059c | 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) = @_; | |
55204971 | 17 | local(@args,$_,$first,$rest); |
18 | local($errs) = 0; | |
a687059c | 19 | |
20 | @args = split( / */, $argumentative ); | |
55204971 | 21 | while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { |
a687059c | 22 | ($first,$rest) = ($1,$2); |
23 | $pos = index($argumentative,$first); | |
55497cff | 24 | if($pos >= 0) { |
25 | if($pos < $#args && $args[$pos+1] eq ':') { | |
bf38876a | 26 | shift(@ARGV); |
a687059c | 27 | if($rest eq '') { |
8adcabd8 | 28 | ++$errs unless @ARGV; |
bf38876a | 29 | $rest = shift(@ARGV); |
a687059c | 30 | } |
55497cff | 31 | ${"opt_$first"} = $rest; |
a687059c | 32 | } |
33 | else { | |
55497cff | 34 | ${"opt_$first"} = 1; |
a687059c | 35 | if($rest eq '') { |
bf38876a | 36 | shift(@ARGV); |
a687059c | 37 | } |
38 | else { | |
39 | $ARGV[0] = "-$rest"; | |
40 | } | |
41 | } | |
42 | } | |
43 | else { | |
ac58e20f | 44 | print STDERR "Unknown option: $first\n"; |
45 | ++$errs; | |
a687059c | 46 | if($rest ne '') { |
47 | $ARGV[0] = "-$rest"; | |
48 | } | |
49 | else { | |
bf38876a | 50 | shift(@ARGV); |
a687059c | 51 | } |
52 | } | |
53 | } | |
ac58e20f | 54 | $errs == 0; |
a687059c | 55 | } |
56 | ||
57 | 1; |