lib/getopts.pl

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