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,$errs);
  10     local($[) = 0;
  11
  12     @args = split( / */, $argumentative );
  13     while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  14         ($first,$rest) = ($1,$2);
  15         $pos = index($argumentative,$first);
  16         if($pos >= $[) {
  17             if($args[$pos+1] eq ':') {
  18                 shift(@ARGV);
  19                 if($rest eq '') {
  20                     $rest = shift(@ARGV);
  21                 }
  22                 eval "\$opt_$first = \$rest;";
  23             }
  24             else {
  25                 eval "\$opt_$first = 1";
  26                 if($rest eq '') {
  27                     shift(@ARGV);
  28                 }
  29                 else {
  30                     $ARGV[0] = "-$rest";
  31                 }
  32             }
  33         }
  34         else {
  35             print STDERR "Unknown option: $first\n";
  36             ++$errs;
  37             if($rest ne '') {
  38                 $ARGV[0] = "-$rest";
  39             }
  40             else {
  41                 shift(@ARGV);
  42             }
  43         }
  44     }
  45     $errs == 0;
  46 }
  47
  48 1;