I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / getopts.pl
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     local($[) = 0;
20
21     @args = split( / */, $argumentative );
22     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
23                 ($first,$rest) = ($1,$2);
24                 $pos = index($argumentative,$first);
25                 if($pos >= $[) {
26                         if($args[$pos+1] eq ':') {
27                                 shift(@ARGV);
28                                 if($rest eq '') {
29                                         ++$errs unless(@ARGV);
30                                         $rest = shift(@ARGV);
31                                 }
32                                 eval "
33                                 push(\@opt_$first, \$rest);
34                                 if(\$opt_$first eq '') {
35                                         \$opt_$first = \$rest;
36                                 }
37                                 else {
38                                         \$opt_$first .= ' ' . \$rest;
39                                 }
40                                 ";
41                         }
42                         else {
43                                 eval "\$opt_$first = 1";
44                                 if($rest eq '') {
45                                         shift(@ARGV);
46                                 }
47                                 else {
48                                         $ARGV[0] = "-$rest";
49                                 }
50                         }
51                 }
52                 else {
53                         print STDERR "Unknown option: $first\n";
54                         ++$errs;
55                         if($rest ne '') {
56                                 $ARGV[0] = "-$rest";
57                         }
58                         else {
59                                 shift(@ARGV);
60                         }
61                 }
62         }
63     $errs == 0;
64 }
65
66 1;