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 ;# 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
  22 sub Getopt {
  23     local($argumentative) = @_;
  24     local($_,$first,$rest);
  25     local($[) = 0;
  26
  27     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  28         ($first,$rest) = ($1,$2);
  29         if (index($argumentative,$first) >= $[) {
  30             if ($rest ne '') {
  31                 shift(@ARGV);
  32             }
  33             else {
  34                 shift(@ARGV);
  35                 $rest = shift(@ARGV);
  36             }
  37             ${"opt_$first"} = $rest;
  38         }
  39         else {
  40             ${"opt_$first"} = 1;
  41             if ($rest ne '') {
  42                 $ARGV[0] = "-$rest";
  43             }
  44             else {
  45                 shift(@ARGV);
  46             }
  47         }
  48     }
  49 }
  50
  51 1;