lib/getopt.pl

   1 warn "Legacy library @{[(caller(0))[6]]} will be removed from the Perl core distribution in the next major release. Please install it from the CPAN distribution Perl4::CoreLibs. It is being used at @{[(caller)[1]]}, line @{[(caller)[2]]}.\n";
   2
   3 ;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
   4 #
   5 # This library is no longer being maintained, and is included for backward
   6 # compatibility with Perl 4 programs which may require it.
   7 # This legacy library is deprecated and will be removed in a future
   8 # release of perl.
   9 #
  10 # In particular, this should not be used as an example of modern Perl
  11 # programming techniques.
  12 #
  13 # Suggested alternatives: Getopt::Long or Getopt::Std
  14
  15 ;# Process single-character switches with switch clustering.  Pass one argument
  16 ;# which is a string containing all switches that take an argument.  For each
  17 ;# switch found, sets $opt_x (where x is the switch name) to the value of the
  18 ;# argument, or 1 if no argument.  Switches which take an argument don't care
  19 ;# whether there is a space between the switch and the argument.
  20
  21 ;# Usage:
  22 ;#      do Getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  23
  24 sub Getopt {
  25     local($argumentative) = @_;
  26     local($_,$first,$rest);
  27
  28     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  29         ($first,$rest) = ($1,$2);
  30         if (index($argumentative,$first) >= 0) {
  31             if ($rest ne '') {
  32                 shift(@ARGV);
  33             }
  34             else {
  35                 shift(@ARGV);
  36                 $rest = shift(@ARGV);
  37             }
  38             ${"opt_$first"} = $rest;
  39         }
  40         else {
  41             ${"opt_$first"} = 1;
  42             if ($rest ne '') {
  43                 $ARGV[0] = "-$rest";
  44             }
  45             else {
  46                 shift(@ARGV);
  47             }
  48         }
  49     }
  50 }
  51
  52 1;