[Summary view] [Print] [Text view]

   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  
  20  sub 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  
  49  1;