This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make pp_reverse fetch the lexical $_ from the correct pad
[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
22059276 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]) =~ /^-(.)(.*)/) {
a60e505a
BC
22 ($first,$rest) = ($1,$2);
23 $pos = index($argumentative,$first);
859172fe 24 if($pos >= 0) {
a60e505a
BC
25 if($args[$pos+1] eq ':') {
26 shift(@ARGV);
27 if($rest eq '') {
28 ++$errs unless(@ARGV);
29 $rest = shift(@ARGV);
30 }
31 eval "
32 push(\@opt_$first, \$rest);
b1fd7ccc 33 if (!defined \$opt_$first or \$opt_$first eq '') {
a60e505a
BC
34 \$opt_$first = \$rest;
35 }
36 else {
37 \$opt_$first .= ' ' . \$rest;
38 }
39 ";
40 }
41 else {
42 eval "\$opt_$first = 1";
43 if($rest eq '') {
44 shift(@ARGV);
45 }
46 else {
47 $ARGV[0] = "-$rest";
48 }
49 }
a687059c
LW
50 }
51 else {
a60e505a
BC
52 print STDERR "Unknown option: $first\n";
53 ++$errs;
54 if($rest ne '') {
55 $ARGV[0] = "-$rest";
56 }
57 else {
58 shift(@ARGV);
59 }
a687059c 60 }
a687059c 61 }
ac58e20f 62 $errs == 0;
a687059c
LW
63}
64
651;