home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / PERL30X.ZIP / GETOPTS.PL < prev    next >
Text File  |  1991-01-14  |  950b  |  49 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,$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;
  49.