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