home *** CD-ROM | disk | FTP | other *** search
/ CLIX - Fazer Clix Custa Nix / CLIX-CD.cdr / mac / lib / Getopt / Std.pm < prev   
Text File  |  1997-05-19  |  4KB  |  157 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.  
  15.     getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
  16.     getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
  17.     getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
  18.               # Sets opt_* as a side effect.
  19.     getopts('oif:', \%opts);  # options as above. Values in %opts
  20.  
  21. =head1 DESCRIPTION
  22.  
  23. The getopt() functions processes single-character switches with switch
  24. clustering.  Pass one argument which is a string containing all switches
  25. that take an argument.  For each switch found, sets $opt_x (where x is the
  26. switch name) to the value of the argument, or 1 if no argument.  Switches
  27. which take an argument don't care whether there is a space between the
  28. switch and the argument.
  29.  
  30. For those of you who don't like additional variables being created, getopt()
  31. and getopts() will also accept a hash reference as an optional second argument. 
  32. Hash keys will be x (where x is the switch name) with key values the value of
  33. the argument or 1 if no argument is specified.
  34.  
  35. =cut
  36.  
  37. @ISA = qw(Exporter);
  38. @EXPORT = qw(getopt getopts);
  39.  
  40. # $RCSfile: Std.pm,v $$Revision: 1.3 $$Date: 1997/05/19 12:32:23 $
  41.  
  42. # Process single-character switches with switch clustering.  Pass one argument
  43. # which is a string containing all switches that take an argument.  For each
  44. # switch found, sets $opt_x (where x is the switch name) to the value of the
  45. # argument, or 1 if no argument.  Switches which take an argument don't care
  46. # whether there is a space between the switch and the argument.
  47.  
  48. # Usage:
  49. #    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  50.  
  51. sub getopt ($;$) {
  52.     local($argumentative, $hash) = @_;
  53.     local($_,$first,$rest);
  54.     local $Exporter::ExportLevel;
  55.  
  56.     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  57.     ($first,$rest) = ($1,$2);
  58.     if (index($argumentative,$first) >= 0) {
  59.         if ($rest ne '') {
  60.         shift(@ARGV);
  61.         }
  62.         else {
  63.         shift(@ARGV);
  64.         $rest = shift(@ARGV);
  65.         }
  66.           if (ref $hash) {
  67.               $$hash{$first} = $rest;
  68.           }
  69.           else {
  70.               eval "\$opt_$first = \$rest;";
  71.               push( @EXPORT, "\$opt_$first" );
  72.           }
  73.     }
  74.     else {
  75.           if (ref $hash) {
  76.               $$hash{$first} = 1;
  77.           }
  78.           else {
  79.               eval "\$opt_$first = 1;";
  80.               push( @EXPORT, "\$opt_$first" );
  81.           }
  82.         if ($rest ne '') {
  83.         $ARGV[0] = "-$rest";
  84.         }
  85.         else {
  86.         shift(@ARGV);
  87.         }
  88.     }
  89.     }
  90.     $Exporter::ExportLevel++;
  91.     import Getopt::Std;
  92. }
  93.  
  94. # Usage:
  95. #   getopts('a:bc');    # -a takes arg. -b & -c not. Sets opt_* as a
  96. #            #  side effect.
  97.  
  98. sub getopts ($;$) {
  99.     local($argumentative, $hash) = @_;
  100.     local(@args,$_,$first,$rest);
  101.     local($errs) = 0;
  102.     local $Exporter::ExportLevel;
  103.  
  104.     @args = split( / */, $argumentative );
  105.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  106.     ($first,$rest) = ($1,$2);
  107.     $pos = index($argumentative,$first);
  108.     if($pos >= 0) {
  109.         if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
  110.         shift(@ARGV);
  111.         if($rest eq '') {
  112.             ++$errs unless @ARGV;
  113.             $rest = shift(@ARGV);
  114.         }
  115.               if (ref $hash) {
  116.                   $$hash{$first} = $rest;
  117.               }
  118.               else {
  119.                   eval "\$opt_$first = \$rest;";
  120.                   push( @EXPORT, "\$opt_$first" );
  121.               }
  122.         }
  123.         else {
  124.               if (ref $hash) {
  125.                   $$hash{$first} = 1;
  126.               }
  127.               else {
  128.                   eval "\$opt_$first = 1";
  129.                   push( @EXPORT, "\$opt_$first" );
  130.               }
  131.         if($rest eq '') {
  132.             shift(@ARGV);
  133.         }
  134.         else {
  135.             $ARGV[0] = "-$rest";
  136.         }
  137.         }
  138.     }
  139.     else {
  140.         print STDERR "Unknown option: $first\n";
  141.         ++$errs;
  142.         if($rest ne '') {
  143.         $ARGV[0] = "-$rest";
  144.         }
  145.         else {
  146.         shift(@ARGV);
  147.         }
  148.     }
  149.     }
  150.     $Exporter::ExportLevel++;
  151.     import Getopt::Std;
  152.     $errs == 0;
  153. }
  154.  
  155. 1;
  156.  
  157.