home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / lib / getopts.pl < prev    next >
Text File  |  1999-07-25  |  1KB  |  58 lines
  1. ;# getopts.pl - a better getopt.pl
  2. #
  3. # This library is no longer being maintained, and is included for backward
  4. # compatibility with Perl 4 programs which may require it.
  5. #
  6. # In particular, this should not be used as an example of modern Perl
  7. # programming techniques.
  8. #
  9. # Suggested alternatives: Getopt::Long  or  Getopt::Std
  10. #
  11. ;# Usage:
  12. ;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
  13. ;#                           #  side effect.
  14.  
  15. sub Getopts {
  16.     local($argumentative) = @_;
  17.     local(@args,$_,$first,$rest);
  18.     local($errs) = 0;
  19.  
  20.     @args = split( / */, $argumentative );
  21.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  22.     ($first,$rest) = ($1,$2);
  23.     $pos = index($argumentative,$first);
  24.     if($pos >= 0) {
  25.         if($pos < $#args && $args[$pos+1] eq ':') {
  26.         shift(@ARGV);
  27.         if($rest eq '') {
  28.             ++$errs unless @ARGV;
  29.             $rest = shift(@ARGV);
  30.         }
  31.         ${"opt_$first"} = $rest;
  32.         }
  33.         else {
  34.         ${"opt_$first"} = 1;
  35.         if($rest eq '') {
  36.             shift(@ARGV);
  37.         }
  38.         else {
  39.             $ARGV[0] = "-$rest";
  40.         }
  41.         }
  42.     }
  43.     else {
  44.         print STDERR "Unknown option: $first\n";
  45.         ++$errs;
  46.         if($rest ne '') {
  47.         $ARGV[0] = "-$rest";
  48.         }
  49.         else {
  50.         shift(@ARGV);
  51.         }
  52.     }
  53.     }
  54.     $errs == 0;
  55. }
  56.  
  57. 1;
  58.