contrib/perl5/lib/getopt.pl

   1 ;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
   2
   3 ;# Process single-character switches with switch clustering.  Pass one argument
   4 ;# which is a string containing all switches that take an argument.  For each
   5 ;# switch found, sets $opt_x (where x is the switch name) to the value of the
   6 ;# argument, or 1 if no argument.  Switches which take an argument don't care
   7 ;# whether there is a space between the switch and the argument.
   8
   9 ;# Usage:
  10 ;#      do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  11
  12 sub Getopt {
  13     local($argumentative) = @_;
  14     local($_,$first,$rest);
  15     local($[) = 0;
  16
  17     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  18         ($first,$rest) = ($1,$2);
  19         if (index($argumentative,$first) >= $[) {
  20             if ($rest ne '') {
  21                 shift(@ARGV);
  22             }
  23             else {
  24                 shift(@ARGV);
  25                 $rest = shift(@ARGV);
  26             }
  27             ${"opt_$first"} = $rest;
  28         }
  29         else {
  30             ${"opt_$first"} = 1;
  31             if ($rest ne '') {
  32                 $ARGV[0] = "-$rest";
  33             }
  34             else {
  35                 shift(@ARGV);
  36             }
  37         }
  38     }
  39 }
  40
  41 1;