This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Benchmark displays bogus CPU stats (suggested by Cedric Auzanne
[perl5.git] / lib / getopts.pl
CommitLineData
a687059c 1;# getopts.pl - a better getopt.pl
a6d71656
GS
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
LW
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
LW
17 local(@args,$_,$first,$rest);
18 local($errs) = 0;
a687059c
LW
19
20 @args = split( / */, $argumentative );
55204971 21 while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
a687059c
LW
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
LW
32 }
33 else {
55497cff 34 ${"opt_$first"} = 1;
a687059c 35 if($rest eq '') {
bf38876a 36 shift(@ARGV);
a687059c
LW
37 }
38 else {
39 $ARGV[0] = "-$rest";
40 }
41 }
42 }
43 else {
ac58e20f
LW
44 print STDERR "Unknown option: $first\n";
45 ++$errs;
a687059c
LW
46 if($rest ne '') {
47 $ARGV[0] = "-$rest";
48 }
49 else {
bf38876a 50 shift(@ARGV);
a687059c
LW
51 }
52 }
53 }
ac58e20f 54 $errs == 0;
a687059c
LW
55}
56
571;