integrate cfgperl contents into mainline

[p5sagit/p5-mst-13.2.git] / lib / getopts.pl

diff --git a/lib/getopts.pl b/lib/getopts.pl
index 9269885..2595819 100644 (file)
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -1,5 +1,13 @@
 ;# getopts.pl - a better getopt.pl
-
+#
+# This library is no longer being maintained, and is included for backward
+# compatibility with Perl 4 programs which may require it.
+#
+# In particular, this should not be used as an example of modern Perl
+# programming techniques.
+#
+# Suggested alternatives: Getopt::Long  or  Getopt::Std
+#
 ;# Usage:
 ;#      do Getopts('a:bc');  # -a takes arg. -b & -c not. Sets opt_* as a
 ;#                           #  side effect.
@@ -7,23 +15,25 @@
 sub Getopts {
     local($argumentative) = @_;
     local(@args,$_,$first,$rest);
+    local($errs) = 0;
 
     @args = split( / */, $argumentative );
-    while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
        ($first,$rest) = ($1,$2);
        $pos = index($argumentative,$first);
-       if($pos >= $[) {
-           if($args[$pos+1] eq ':') {
-               shift;
+       if($pos >= 0) {
+           if($pos < $#args && $args[$pos+1] eq ':') {
+               shift(@ARGV);
                if($rest eq '') {
-                   $rest = shift;
+                   ++$errs unless @ARGV;
+                   $rest = shift(@ARGV);
                }
-               eval "\$opt_$first = \$rest;";
+               ${"opt_$first"} = $rest;
            }
            else {
-               eval "\$opt_$first = 1";
+               ${"opt_$first"} = 1;
                if($rest eq '') {
-                   shift;
+                   shift(@ARGV);
                }
                else {
                    $ARGV[0] = "-$rest";
@@ -31,15 +41,17 @@ sub Getopts {
            }
        }
        else {
-           print stderr "Unknown option: $first\n";
+           print STDERR "Unknown option: $first\n";
+           ++$errs;
            if($rest ne '') {
                $ARGV[0] = "-$rest";
            }
            else {
-               shift;
+               shift(@ARGV);
            }
        }
     }
+    $errs == 0;
 }
 
 1;