X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fgetopts.pl;h=b2aa5cb60e19eccbc05560eaa0936f8549f458fa;hb=9b463b21d3655b79309f8b461042cebb5733c54e;hp=7effafa195c9296b05f354d82acf1fd0210113d6;hpb=bf38876a182e0df9dd73362f56cf0ab8b43aa789;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/getopts.pl b/lib/getopts.pl
index 7effafa..b2aa5cb 100644
--- a/lib/getopts.pl
+++ b/lib/getopts.pl
@@ -1,4 +1,12 @@
 ;# 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
@@ -7,39 +15,52 @@
 sub Getopts {
     local($argumentative) = @_;
     local(@args,$_,$first,$rest);
+    local($errs) = 0;
+    local($[) = 0;
 
     @args = split( / */, $argumentative );
-    while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
-	($first,$rest) = ($1,$2);
-	$pos = index($argumentative,$first);
-	if($pos >= $[) {
-	    if($args[$pos+1] eq ':') {
-		shift(@ARGV);
-		if($rest eq '') {
-		    $rest = shift(@ARGV);
-		}
-		eval "\$opt_$first = \$rest;";
-	    }
-	    else {
-		eval "\$opt_$first = 1";
-		if($rest eq '') {
-		    shift(@ARGV);
+    while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
+		($first,$rest) = ($1,$2);
+		$pos = index($argumentative,$first);
+		if($pos >= $[) {
+			if($args[$pos+1] eq ':') {
+				shift(@ARGV);
+				if($rest eq '') {
+					++$errs unless(@ARGV);
+					$rest = shift(@ARGV);
+				}
+				eval "
+				push(\@opt_$first, \$rest);
+				if (!defined \$opt_$first or \$opt_$first eq '') {
+					\$opt_$first = \$rest;
+				}
+				else {
+					\$opt_$first .= ' ' . \$rest;
+				}
+				";
+			}
+			else {
+				eval "\$opt_$first = 1";
+				if($rest eq '') {
+					shift(@ARGV);
+				}
+				else {
+					$ARGV[0] = "-$rest";
+				}
+			}
 		}
 		else {
-		    $ARGV[0] = "-$rest";
+			print STDERR "Unknown option: $first\n";
+			++$errs;
+			if($rest ne '') {
+				$ARGV[0] = "-$rest";
+			}
+			else {
+				shift(@ARGV);
+			}
 		}
-	    }
-	}
-	else {
-	    print stderr "Unknown option: $first\n";
-	    if($rest ne '') {
-		$ARGV[0] = "-$rest";
-	    }
-	    else {
-		shift(@ARGV);
-	    }
 	}
-    }
+    $errs == 0;
 }
 
 1;