I don't think trying to bracket the hires time with lores
[p5sagit/p5-mst-13.2.git] / lib / getopts.pl
CommitLineData
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
15sub Getopts {
16 local($argumentative) = @_;
55204971 17 local(@args,$_,$first,$rest);
18 local($errs) = 0;
a60e505a 19 local($[) = 0;
a687059c 20
21 @args = split( / */, $argumentative );
55204971 22 while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
a60e505a 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 }
a687059c 51 }
52 else {
a60e505a 53 print STDERR "Unknown option: $first\n";
54 ++$errs;
55 if($rest ne '') {
56 $ARGV[0] = "-$rest";
57 }
58 else {
59 shift(@ARGV);
60 }
a687059c 61 }
a687059c 62 }
ac58e20f 63 $errs == 0;
a687059c 64}
65
661;