This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix a2p translation of '{print "a" "b" "c"}'
[perl5.git] / lib / getopts.pl
CommitLineData
a687059c
LW
1;# getopts.pl - a better getopt.pl
2
3;# Usage:
4;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
5;# # side effect.
6
7sub Getopts {
8 local($argumentative) = @_;
55204971
LW
9 local(@args,$_,$first,$rest);
10 local($errs) = 0;
ac58e20f 11 local($[) = 0;
a687059c
LW
12
13 @args = split( / */, $argumentative );
55204971 14 while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
a687059c
LW
15 ($first,$rest) = ($1,$2);
16 $pos = index($argumentative,$first);
17 if($pos >= $[) {
18 if($args[$pos+1] eq ':') {
bf38876a 19 shift(@ARGV);
a687059c 20 if($rest eq '') {
8adcabd8 21 ++$errs unless @ARGV;
bf38876a 22 $rest = shift(@ARGV);
a687059c
LW
23 }
24 eval "\$opt_$first = \$rest;";
25 }
26 else {
27 eval "\$opt_$first = 1";
28 if($rest eq '') {
bf38876a 29 shift(@ARGV);
a687059c
LW
30 }
31 else {
32 $ARGV[0] = "-$rest";
33 }
34 }
35 }
36 else {
ac58e20f
LW
37 print STDERR "Unknown option: $first\n";
38 ++$errs;
a687059c
LW
39 if($rest ne '') {
40 $ARGV[0] = "-$rest";
41 }
42 else {
bf38876a 43 shift(@ARGV);
a687059c
LW
44 }
45 }
46 }
ac58e20f 47 $errs == 0;
a687059c
LW
48}
49
501;