xref: /onnv-gate/usr/src/cmd/perl/5.8.4/distrib/lib/getopt.pl (revision 0:68f95e015346)
1;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
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#
11;# Process single-character switches with switch clustering.  Pass one argument
12;# which is a string containing all switches that take an argument.  For each
13;# switch found, sets $opt_x (where x is the switch name) to the value of the
14;# argument, or 1 if no argument.  Switches which take an argument don't care
15;# whether there is a space between the switch and the argument.
16
17;# Usage:
18;#	do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
19
20sub Getopt {
21    local($argumentative) = @_;
22    local($_,$first,$rest);
23    local($[) = 0;
24
25    while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
26	($first,$rest) = ($1,$2);
27	if (index($argumentative,$first) >= $[) {
28	    if ($rest ne '') {
29		shift(@ARGV);
30	    }
31	    else {
32		shift(@ARGV);
33		$rest = shift(@ARGV);
34	    }
35	    ${"opt_$first"} = $rest;
36	}
37	else {
38	    ${"opt_$first"} = 1;
39	    if ($rest ne '') {
40		$ARGV[0] = "-$rest";
41	    }
42	    else {
43		shift(@ARGV);
44	    }
45	}
46    }
47}
48
491;
50