Zero entries were skipped, fix from Adrian Goalby
[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;
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
571;