home *** CD-ROM | disk | FTP | other *** search
/ PC World 2004 November / PCWorld_2004-11_cd.bin / software / topware / activeperl / ActivePerl-5.8.4.810-MSWin32-x86.exe / ActivePerl-5.8.4.810 / Perl / lib / getopts.pl < prev    next >
Text File  |  2004-06-01  |  1KB  |  67 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.     local($[) = 0;
  20.  
  21.     @args = split( / */, $argumentative );
  22.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  23.         ($first,$rest) = ($1,$2);
  24.         $pos = index($argumentative,$first);
  25.         if($pos >= $[) {
  26.             if($args[$pos+1] eq ':') {
  27.                 shift(@ARGV);
  28.                 if($rest eq '') {
  29.                     ++$errs unless(@ARGV);
  30.                     $rest = shift(@ARGV);
  31.                 }
  32.                 eval "
  33.                 push(\@opt_$first, \$rest);
  34.                 if(\$opt_$first eq '') {
  35.                     \$opt_$first = \$rest;
  36.                 }
  37.                 else {
  38.                     \$opt_$first .= ' ' . \$rest;
  39.                 }
  40.                 ";
  41.             }
  42.             else {
  43.                 eval "\$opt_$first = 1";
  44.                 if($rest eq '') {
  45.                     shift(@ARGV);
  46.                 }
  47.                 else {
  48.                     $ARGV[0] = "-$rest";
  49.                 }
  50.             }
  51.         }
  52.         else {
  53.             print STDERR "Unknown option: $first\n";
  54.             ++$errs;
  55.             if($rest ne '') {
  56.                 $ARGV[0] = "-$rest";
  57.             }
  58.             else {
  59.                 shift(@ARGV);
  60.             }
  61.         }
  62.     }
  63.     $errs == 0;
  64. }
  65.  
  66. 1;
  67.