contrib/perl5/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
  12     @args = split( / */, $argumentative );
  13     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  14         ($first,$rest) = ($1,$2);
  15         $pos = index($argumentative,$first);
  16         if($pos >= 0) {
  17             if($pos < $#args && $args[$pos+1] eq ':') {
  18                 shift(@ARGV);
  19                 if($rest eq '') {
  20                     ++$errs unless @ARGV;
  21                     $rest = shift(@ARGV);
  22                 }
  23                 ${"opt_$first"} = $rest;
  24             }
  25             else {
  26                 ${"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;