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