lib/getopts.pl

   1 ;# getopts.pl - a better getopt.pl
   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 ;# Usage:
  12 ;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
  13 ;#                           #  side effect.
  14
  15 sub Getopts {
  16     local($argumentative) = @_;
  17     local(@args,$_,$first,$rest);
  18     local($errs) = 0;
  19
  20     @args = split( / */, $argumentative );
  21     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  22         ($first,$rest) = ($1,$2);
  23         $pos = index($argumentative,$first);
  24         if($pos >= 0) {
  25             if($pos < $#args && $args[$pos+1] eq ':') {
  26                 shift(@ARGV);
  27                 if($rest eq '') {
  28                     ++$errs unless @ARGV;
  29                     $rest = shift(@ARGV);
  30                 }
  31                 ${"opt_$first"} = $rest;
  32             }
  33             else {
  34                 ${"opt_$first"} = 1;
  35                 if($rest eq '') {
  36                     shift(@ARGV);
  37                 }
  38                 else {
  39                     $ARGV[0] = "-$rest";
  40                 }
  41             }
  42         }
  43         else {
  44             print STDERR "Unknown option: $first\n";
  45             ++$errs;
  46             if($rest ne '') {
  47                 $ARGV[0] = "-$rest";
  48             }
  49             else {
  50                 shift(@ARGV);
  51             }
  52         }
  53     }
  54     $errs == 0;
  55 }
  56
  57 1;