386BSD 0.1 development

[unix-history] / usr / othersrc / public / perl-4.019 / lib / getopts.pl

;# getopts.pl - a better getopt.pl

;# Usage:
;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
;#                           #  side effect.

sub Getopts {
   local($argumentative) = @_;
   local(@args,$_,$first,$rest);
   local($errs) = 0;
   local($[) = 0;

   @args = split( / */, $argumentative );
   while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
       ($first,$rest) = ($1,$2);
       $pos = index($argumentative,$first);
       if($pos >= $[) {
           if($args[$pos+1] eq ':') {
               shift(@ARGV);
               if($rest eq '') {
                   $rest = shift(@ARGV);
               }
               eval "\$opt_$first = \$rest;";
           }
           else {
               eval "\$opt_$first = 1";
               if($rest eq '') {
                   shift(@ARGV);
               }
               else {
                   $ARGV[0] = "-$rest";
               }
           }
       }
       else {
           print STDERR "Unknown option: $first\n";
           ++$errs;
           if($rest ne '') {
               $ARGV[0] = "-$rest";
           }
           else {
               shift(@ARGV);
           }
       }
   }
   $errs == 0;
}

1;