Upped VERSION
[p5sagit/p5-mst-13.2.git] / lib / getopt.pl
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 # This legacy library is deprecated and will be removed in a future
6 # release of perl.
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
12
13 warn( "The 'getopt.pl' legacy library is deprecated and will be"
14       . " removed in the next major release of perl. Please use the"
15       . " Getopt::Long or Getopt::Std modules instead." );
16
17 ;# Process single-character switches with switch clustering.  Pass one argument
18 ;# which is a string containing all switches that take an argument.  For each
19 ;# switch found, sets $opt_x (where x is the switch name) to the value of the
20 ;# argument, or 1 if no argument.  Switches which take an argument don't care
21 ;# whether there is a space between the switch and the argument.
22
23 ;# Usage:
24 ;#      do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
25
26 sub Getopt {
27     local($argumentative) = @_;
28     local($_,$first,$rest);
29     local($[) = 0;
30
31     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
32         ($first,$rest) = ($1,$2);
33         if (index($argumentative,$first) >= $[) {
34             if ($rest ne '') {
35                 shift(@ARGV);
36             }
37             else {
38                 shift(@ARGV);
39                 $rest = shift(@ARGV);
40             }
41             ${"opt_$first"} = $rest;
42         }
43         else {
44             ${"opt_$first"} = 1;
45             if ($rest ne '') {
46                 $ARGV[0] = "-$rest";
47             }
48             else {
49                 shift(@ARGV);
50             }
51         }
52     }
53 }
54
55 1;