home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl501m.zip / lib / Getopt / Std.pm < prev   
Text File  |  1995-07-03  |  3KB  |  129 lines
  1. package Getopt::Std;
  2. require 5.000;
  3. require Exporter;
  4.  
  5. =head1 NAME
  6.  
  7. getopt - Process single-character switches with switch clustering
  8.  
  9. getopts - Process single-character switches with switch clustering
  10.  
  11. =head1 SYNOPSIS
  12.  
  13.     use Getopt::Std;
  14.     getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  15.     getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
  16.               # Sets opt_* as a side effect.
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. The getopt() functions processes single-character switches with switch
  21. clustering.  Pass one argument which is a string containing all switches
  22. that take an argument.  For each switch found, sets $opt_x (where x is the
  23. switch name) to the value of the argument, or 1 if no argument.  Switches
  24. which take an argument don't care whether there is a space between the
  25. switch and the argument.
  26.  
  27. =cut
  28.  
  29. @ISA = qw(Exporter);
  30. @EXPORT = qw(getopt getopts);
  31.  
  32. # $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
  33.  
  34. # Process single-character switches with switch clustering.  Pass one argument
  35. # which is a string containing all switches that take an argument.  For each
  36. # switch found, sets $opt_x (where x is the switch name) to the value of the
  37. # argument, or 1 if no argument.  Switches which take an argument don't care
  38. # whether there is a space between the switch and the argument.
  39.  
  40. # Usage:
  41. #    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  42.  
  43. sub getopt {
  44.     local($argumentative) = @_;
  45.     local($_,$first,$rest);
  46.     local $Exporter::ExportLevel;
  47.  
  48.     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  49.     ($first,$rest) = ($1,$2);
  50.     if (index($argumentative,$first) >= 0) {
  51.         if ($rest ne '') {
  52.         shift(@ARGV);
  53.         }
  54.         else {
  55.         shift(@ARGV);
  56.         $rest = shift(@ARGV);
  57.         }
  58.         eval "\$opt_$first = \$rest;";
  59.         push( @EXPORT, "\$opt_$first" );
  60.     }
  61.     else {
  62.         eval "\$opt_$first = 1;";
  63.         push( @EXPORT, "\$opt_$first" );
  64.         if ($rest ne '') {
  65.         $ARGV[0] = "-$rest";
  66.         }
  67.         else {
  68.         shift(@ARGV);
  69.         }
  70.     }
  71.     }
  72.     $Exporter::ExportLevel++;
  73.     import Getopt::Std;
  74. }
  75.  
  76. # Usage:
  77. #   getopts('a:bc');    # -a takes arg. -b & -c not. Sets opt_* as a
  78. #            #  side effect.
  79.  
  80. sub getopts {
  81.     local($argumentative) = @_;
  82.     local(@args,$_,$first,$rest);
  83.     local($errs) = 0;
  84.     local $Exporter::ExportLevel;
  85.  
  86.     @args = split( / */, $argumentative );
  87.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  88.     ($first,$rest) = ($1,$2);
  89.     $pos = index($argumentative,$first);
  90.     if($pos >= 0) {
  91.         if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
  92.         shift(@ARGV);
  93.         if($rest eq '') {
  94.             ++$errs unless @ARGV;
  95.             $rest = shift(@ARGV);
  96.         }
  97.         eval "\$opt_$first = \$rest;";
  98.         push( @EXPORT, "\$opt_$first" );
  99.         }
  100.         else {
  101.         eval "\$opt_$first = 1";
  102.         push( @EXPORT, "\$opt_$first" );
  103.         if($rest eq '') {
  104.             shift(@ARGV);
  105.         }
  106.         else {
  107.             $ARGV[0] = "-$rest";
  108.         }
  109.         }
  110.     }
  111.     else {
  112.         print STDERR "Unknown option: $first\n";
  113.         ++$errs;
  114.         if($rest ne '') {
  115.         $ARGV[0] = "-$rest";
  116.         }
  117.         else {
  118.         shift(@ARGV);
  119.         }
  120.     }
  121.     }
  122.     $Exporter::ExportLevel++;
  123.     import Getopt::Std;
  124.     $errs == 0;
  125. }
  126.  
  127. 1;
  128.  
  129.