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 / getopt.pl
CommitLineData
79072805 1;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
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.
e3bc9a01
S
5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656
GS
7#
8# In particular, this should not be used as an example of modern Perl
9# programming techniques.
10#
11# Suggested alternatives: Getopt::Long or Getopt::Std
e3bc9a01 12
378cc40b
LW
13;# Process single-character switches with switch clustering. Pass one argument
14;# which is a string containing all switches that take an argument. For each
15;# switch found, sets $opt_x (where x is the switch name) to the value of the
16;# argument, or 1 if no argument. Switches which take an argument don't care
17;# whether there is a space between the switch and the argument.
18
19;# Usage:
20;# do Getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect.
21
22sub Getopt {
23 local($argumentative) = @_;
24 local($_,$first,$rest);
25
55204971 26 while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
378cc40b 27 ($first,$rest) = ($1,$2);
859172fe 28 if (index($argumentative,$first) >= 0) {
378cc40b 29 if ($rest ne '') {
a687059c 30 shift(@ARGV);
378cc40b
LW
31 }
32 else {
a687059c
LW
33 shift(@ARGV);
34 $rest = shift(@ARGV);
378cc40b 35 }
29d4204f 36 ${"opt_$first"} = $rest;
378cc40b
LW
37 }
38 else {
29d4204f 39 ${"opt_$first"} = 1;
378cc40b
LW
40 if ($rest ne '') {
41 $ARGV[0] = "-$rest";
42 }
43 else {
a687059c 44 shift(@ARGV);
378cc40b
LW
45 }
46 }
47 }
48}
a687059c
LW
49
501;