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                     $rest = shift(@ARGV);
  22                 }
  23                 eval "\$opt_$first = \$rest;";
  24             }
  25             else {
  26                 eval "\$opt_$first = 1";
  27                 if($rest eq '') {
  28                     shift(@ARGV);
  29                 }
  30                 else {
  31                     $ARGV[0] = "-$rest";
  32                 }
  33             }
  34         }
  35         else {
  36             print STDERR "Unknown option: $first\n";
  37             ++$errs;
  38             if($rest ne '') {
  39                 $ARGV[0] = "-$rest";
  40             }
  41             else {
  42                 shift(@ARGV);
  43             }
  44         }
  45     }
  46     $errs == 0;
  47 }
  48
  49 1;