POD: Use F<> for F<utils/perldoc> and F<utils/perldoc.PL>
[p5sagit/p5-mst-13.2.git] / lib / getopt.pl
CommitLineData
79072805 1;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
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.
e3bc9a01 5# This legacy library is deprecated and will be removed in a future
6# release of perl.
a6d71656 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 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);
ac58e20f 25 local($[) = 0;
378cc40b 26
55204971 27 while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
378cc40b 28 ($first,$rest) = ($1,$2);
29 if (index($argumentative,$first) >= $[) {
30 if ($rest ne '') {
a687059c 31 shift(@ARGV);
378cc40b 32 }
33 else {
a687059c 34 shift(@ARGV);
35 $rest = shift(@ARGV);
378cc40b 36 }
29d4204f 37 ${"opt_$first"} = $rest;
378cc40b 38 }
39 else {
29d4204f 40 ${"opt_$first"} = 1;
378cc40b 41 if ($rest ne '') {
42 $ARGV[0] = "-$rest";
43 }
44 else {
a687059c 45 shift(@ARGV);
378cc40b 46 }
47 }
48 }
49}
a687059c 50
511;