Pod::Parser updates (v1.091) from Brad Appleton <bradapp@enteract.com>

[p5sagit/p5-mst-13.2.git] / lib / Getopt / Std.pm

diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm
index e1de3b5..390bf14 100644 (file)
--- a/lib/Getopt/Std.pm
+++ b/lib/Getopt/Std.pm
@@ -2,10 +2,47 @@ package Getopt::Std;
 require 5.000;
 require Exporter;
 
+=head1 NAME
+
+getopt - Process single-character switches with switch clustering
+
+getopts - Process single-character switches with switch clustering
+
+=head1 SYNOPSIS
+
+    use Getopt::Std;
+
+    getopt('oDI');    # -o, -D & -I take arg.  Sets opt_* as a side effect.
+    getopt('oDI', \%opts);    # -o, -D & -I take arg.  Values in %opts
+    getopts('oif:');  # -o & -i are boolean flags, -f takes an argument
+                     # Sets opt_* as a side effect.
+    getopts('oif:', \%opts);  # options as above. Values in %opts
+
+=head1 DESCRIPTION
+
+The getopt() functions processes single-character switches with switch
+clustering.  Pass one argument which is a string containing all switches
+that take an argument.  For each switch found, sets $opt_x (where x is the
+switch name) to the value of the argument, or 1 if no argument.  Switches
+which take an argument don't care whether there is a space between the
+switch and the argument.
+
+Note that, if your code is running under the recommended C<use strict
+'vars'> pragma, it may be helpful to declare these package variables
+via C<use vars> perhaps something like this:
+
+    use vars qw/ $opt_foo $opt_bar /;
+
+For those of you who don't like additional variables being created, getopt()
+and getopts() will also accept a hash reference as an optional second argument. 
+Hash keys will be x (where x is the switch name) with key values the value of
+the argument or 1 if no argument is specified.
+
+=cut
+
 @ISA = qw(Exporter);
 @EXPORT = qw(getopt getopts);
-
-# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+$VERSION = $VERSION = '1.01';
 
 # Process single-character switches with switch clustering.  Pass one argument
 # which is a string containing all switches that take an argument.  For each
@@ -16,10 +53,10 @@ require Exporter;
 # Usage:
 #      getopt('oDI');  # -o, -D & -I take arg.  Sets opt_* as a side effect.
 
-sub getopt {
-    local($argumentative) = @_;
+sub getopt ($;$) {
+    local($argumentative, $hash) = @_;
     local($_,$first,$rest);
-    local $Exporter::ExportLevel;
+    local @EXPORT;
 
     while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
@@ -31,12 +68,22 @@ sub getopt {
                shift(@ARGV);
                $rest = shift(@ARGV);
            }
-           eval "\$opt_$first = \$rest;";
-           push( @EXPORT, "\$opt_$first" );
+          if (ref $hash) {
+              $$hash{$first} = $rest;
+          }
+          else {
+              ${"opt_$first"} = $rest;
+              push( @EXPORT, "\$opt_$first" );
+          }
        }
        else {
-           eval "\$opt_$first = 1;";
-           push( @EXPORT, "\$opt_$first" );
+          if (ref $hash) {
+              $$hash{$first} = 1;
+          }
+          else {
+              ${"opt_$first"} = 1;
+              push( @EXPORT, "\$opt_$first" );
+          }
            if ($rest ne '') {
                $ARGV[0] = "-$rest";
            }
@@ -45,37 +92,49 @@ sub getopt {
            }
        }
     }
-    $Exporter::ExportLevel++;
-    import Getopt::Std;
+    unless (ref $hash) { 
+       local $Exporter::ExportLevel = 1;
+       import Getopt::Std;
+    }
 }
 
 # Usage:
 #   getopts('a:bc');   # -a takes arg. -b & -c not. Sets opt_* as a
 #                      #  side effect.
 
-sub getopts {
-    local($argumentative) = @_;
+sub getopts ($;$) {
+    local($argumentative, $hash) = @_;
     local(@args,$_,$first,$rest);
     local($errs) = 0;
-    local $Exporter::ExportLevel;
+    local @EXPORT;
 
     @args = split( / */, $argumentative );
     while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        $pos = index($argumentative,$first);
        if($pos >= 0) {
-           if($args[$pos+1] eq ':') {
+           if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
                shift(@ARGV);
                if($rest eq '') {
                    ++$errs unless @ARGV;
                    $rest = shift(@ARGV);
                }
-               eval "\$opt_$first = \$rest;";
-               push( @EXPORT, "\$opt_$first" );
+              if (ref $hash) {
+                  $$hash{$first} = $rest;
+              }
+              else {
+                  ${"opt_$first"} = $rest;
+                  push( @EXPORT, "\$opt_$first" );
+              }
            }
            else {
-               eval "\$opt_$first = 1";
-               push( @EXPORT, "\$opt_$first" );
+              if (ref $hash) {
+                  $$hash{$first} = 1;
+              }
+              else {
+                  ${"opt_$first"} = 1;
+                  push( @EXPORT, "\$opt_$first" );
+              }
                if($rest eq '') {
                    shift(@ARGV);
                }
@@ -85,7 +144,7 @@ sub getopts {
            }
        }
        else {
-           print STDERR "Unknown option: $first\n";
+           warn "Unknown option: $first\n";
            ++$errs;
            if($rest ne '') {
                $ARGV[0] = "-$rest";
@@ -95,8 +154,10 @@ sub getopts {
            }
        }
     }
-    $Exporter::ExportLevel++;
-    import Getopt::Std;
+    unless (ref $hash) { 
+       local $Exporter::ExportLevel = 1;
+       import Getopt::Std;
+    }
     $errs == 0;
 }