lib/perl5/5.6.1/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 #
   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;