X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FGetopt%2FStd.pm;h=e5b369ceb5782ebe4b98585f57f85509fa6df9c2;hb=0064a8a9866779dceb087452b9bfaa733c51adce;hp=4117ca7f8b5697335e629c2b1b0b7100476aaf81;hpb=f06db76b9e41859439aeadb79feb6c603ee741ff;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm
index 4117ca7..e5b369c 100644
--- a/lib/Getopt/Std.pm
+++ b/lib/Getopt/Std.pm
@@ -11,9 +11,12 @@ 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');    # -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
 
@@ -24,12 +27,26 @@ 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, you will need to declare these package variables
+with "our":
+
+    our($opt_foo, $opt_bar);
+
+For those of you who don't like additional global 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.
+
+To allow programs to process arguments that look like switches, but aren't,
+both functions will stop processing switches when they see the argument
+C<-->.  The C<--> will be removed from @ARGV.
+
 =cut
 
 @ISA = qw(Exporter);
 @EXPORT = qw(getopt getopts);
-
-# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
+$VERSION = '1.02';
 
 # Process single-character switches with switch clustering.  Pass one argument
 # which is a string containing all switches that take an argument.  For each
@@ -40,13 +57,17 @@ switch and the argument.
 # 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);
+	if (/^--$/) {	# early exit if --
+	    shift @ARGV;
+	    last;
+	}
 	if (index($argumentative,$first) >= 0) {
 	    if ($rest ne '') {
 		shift(@ARGV);
@@ -55,12 +76,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";
 	    }
@@ -69,38 +100,54 @@ 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);
+	if (/^--$/) {	# early exit if --
+	    shift @ARGV;
+	    last;
+	}
 	$pos = index($argumentative,$first);
-	if($pos >= 0) {
-	    if(defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
+	if ($pos >= 0) {
+	    if (defined($args[$pos+1]) and ($args[$pos+1] eq ':')) {
 		shift(@ARGV);
-		if($rest eq '') {
+		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($rest eq '') {
+		if (ref $hash) {
+		    $$hash{$first} = 1;
+		}
+		else {
+		    ${"opt_$first"} = 1;
+		    push( @EXPORT, "\$opt_$first" );
+		}
+		if ($rest eq '') {
 		    shift(@ARGV);
 		}
 		else {
@@ -109,9 +156,9 @@ sub getopts {
 	    }
 	}
 	else {
-	    print STDERR "Unknown option: $first\n";
+	    warn "Unknown option: $first\n";
 	    ++$errs;
-	    if($rest ne '') {
+	    if ($rest ne '') {
 		$ARGV[0] = "-$rest";
 	    }
 	    else {
@@ -119,10 +166,11 @@ sub getopts {
 	    }
 	}
     }
-    $Exporter::ExportLevel++;
-    import Getopt::Std;
+    unless (ref $hash) { 
+	local $Exporter::ExportLevel = 1;
+	import Getopt::Std;
+    }
     $errs == 0;
 }
 
 1;
-