home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl502b.zip / lib / getopts.pl < prev    next >
Text File  |  1994-10-18  |  955b  |  51 lines
  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;
  51.