home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_perl.idb / usr / freeware / lib / perl5 / 5.00502 / Getopt / Std.pm.z / Std.pm
Encoding:
Perl POD Document  |  1998-10-28  |  4.3 KB  |  167 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. Note that, if your code is running under the recommended C<use strict
  31. 'vars'> pragma, it may be helpful to declare these package variables
  32. via C<use vars> perhaps something like this:
  33.  
  34.     use vars qw/ $opt_foo $opt_bar /;
  35.  
  36. For those of you who don't like additional variables being created, getopt()
  37. and getopts() will also accept a hash reference as an optional second argument. 
  38. Hash keys will be x (where x is the switch name) with key values the value of
  39. the argument or 1 if no argument is specified.
  40.  
  41. =cut
  42.  
  43. @ISA = qw(Exporter);
  44. @EXPORT = qw(getopt getopts);
  45.  
  46. # $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
  47.  
  48. # Process single-character switches with switch clustering.  Pass one argument
  49. # which is a string containing all switches that take an argument.  For each
  50. # switch found, sets $opt_x (where x is the switch name) to the value of the
  51. # argument, or 1 if no argument.  Switches which take an argument don't care
  52. # whether there is a space between the switch and the argument.
  53.  
  54. # Usage:
  55. #    getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
  56.  
  57. sub getopt ($;$) {
  58.     local($argumentative, $hash) = @_;
  59.     local($_,$first,$rest);
  60.     local @EXPORT;
  61.  
  62.     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  63.     ($first,$rest) = ($1,$2);
  64.     if (index($argumentative,$first) >= 0) {
  65.         if ($rest ne '') {
  66.         shift(@ARGV);
  67.         }
  68.         else {
  69.         shift(@ARGV);
  70.         $rest = shift(@ARGV);
  71.         }
  72.           if (ref $hash) {
  73.               $$hash{$first} = $rest;
  74.           }
  75.           else {
  76.               ${"opt_$first"} = $rest;
  77.               push( @EXPORT, "\$opt_$first" );
  78.           }
  79.     }
  80.     else {
  81.           if (ref $hash) {
  82.               $$hash{$first} = 1;
  83.           }
  84.           else {
  85.               ${"opt_$first"} = 1;
  86.               push( @EXPORT, "\$opt_$first" );
  87.           }
  88.         if ($rest ne '') {
  89.         $ARGV[0] = "-$rest";
  90.         }
  91.         else {
  92.         shift(@ARGV);
  93.         }
  94.     }
  95.     }
  96.     unless (ref $hash) { 
  97.     local $Exporter::ExportLevel = 1;
  98.     import Getopt::Std;
  99.     }
  100. }
  101.  
  102. # Usage:
  103. #   getopts('a:bc');    # -a takes arg. -b & -c not. Sets opt_* as a
  104. #            #  side effect.
  105.  
  106. sub getopts ($;$) {
  107.     local($argumentative, $hash) = @_;
  108.     local(@args,$_,$first,$rest);
  109.     local($errs) = 0;
  110.     local @EXPORT;
  111.  
  112.     @args = split( / */, $argumentative );
  113.     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
  114.     ($first,$rest) = ($1,$2);
  115.     $pos = index($argumentative,$first);
  116.     if($pos >= 0) {
  117.         if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
  118.         shift(@ARGV);
  119.         if($rest eq '') {
  120.             ++$errs unless @ARGV;
  121.             $rest = shift(@ARGV);
  122.         }
  123.               if (ref $hash) {
  124.                   $$hash{$first} = $rest;
  125.               }
  126.               else {
  127.                   ${"opt_$first"} = $rest;
  128.                   push( @EXPORT, "\$opt_$first" );
  129.               }
  130.         }
  131.         else {
  132.               if (ref $hash) {
  133.                   $$hash{$first} = 1;
  134.               }
  135.               else {
  136.                   ${"opt_$first"} = 1;
  137.                   push( @EXPORT, "\$opt_$first" );
  138.               }
  139.         if($rest eq '') {
  140.             shift(@ARGV);
  141.         }
  142.         else {
  143.             $ARGV[0] = "-$rest";
  144.         }
  145.         }
  146.     }
  147.     else {
  148.         print STDERR "Unknown option: $first\n";
  149.         ++$errs;
  150.         if($rest ne '') {
  151.         $ARGV[0] = "-$rest";
  152.         }
  153.         else {
  154.         shift(@ARGV);
  155.         }
  156.     }
  157.     }
  158.     unless (ref $hash) { 
  159.     local $Exporter::ExportLevel = 1;
  160.     import Getopt::Std;
  161.     }
  162.     $errs == 0;
  163. }
  164.  
  165. 1;
  166.  
  167.