X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEnglish.pm;h=118a95a0019e9b8eef5217e894aa88ca3f437f8a;hb=12ac2576dfc10fd43d91903e7602870c10b4f00f;hp=d82ba2cf52f2c002a75990e72276c03c45b369da;hpb=f06db76b9e41859439aeadb79feb6c603ee741ff;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/English.pm b/lib/English.pm
index d82ba2c..118a95a 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -1,5 +1,7 @@
 package English;
 
+our $VERSION = '1.02';
+
 require Exporter;
 @ISA = (Exporter);
 
@@ -9,6 +11,7 @@ English - use nice English (or awk) names for ugly punctuation variables
 
 =head1 SYNOPSIS
 
+    use English qw( -no_match_vars ) ;  # Avoids regex performance penalty
     use English;
     ...
     if ($ERRNO =~ /denied/) { ... }
@@ -27,23 +30,52 @@ $INPUT_RECORD_SEPARATOR if you are using the English module.
 
 See L<perlvar> for a complete list of these.
 
+=head1 PERFORMANCE
+
+This module can provoke sizeable inefficiencies for regular expressions,
+due to unfortunate implementation details.  If performance matters in
+your application and you don't need $PREMATCH, $MATCH, or $POSTMATCH,
+try doing
+
+   use English qw( -no_match_vars ) ;
+
+.  B<It is especially important to do this in modules to avoid penalizing
+all applications which use them.>
+
 =cut
 
-local $^W = 0;
+no warnings;
+
+my $globbed_match ;
 
 # Grandfather $NAME import
 sub import {
     my $this = shift;
-    my @list = @_;
+    my @list = grep { ! /^-no_match_vars$/ } @_ ;
     local $Exporter::ExportLevel = 1;
+    if ( @_ == @list ) {
+        *EXPORT = \@COMPLETE_EXPORT ;
+        $globbed_match ||= (
+	    eval q{
+		*MATCH				= *&	;
+		*PREMATCH			= *`	;
+		*POSTMATCH			= *'	;
+		1 ;
+	       }
+	    || do {
+		require Carp ;
+		Carp::croak "Can't create English for match leftovers: $@" ;
+	    }
+	) ;
+    }
+    else {
+        *EXPORT = \@MINIMAL_EXPORT ;
+    }
     Exporter::import($this,grep {s/^\$/*/} @list);
 }
 
-@EXPORT = qw(
+@MINIMAL_EXPORT = qw(
 	*ARG
-	*MATCH
-	*PREMATCH
-	*POSTMATCH
 	*LAST_PAREN_MATCH
 	*INPUT_LINE_NUMBER
 	*NR
@@ -67,6 +99,7 @@ sub import {
 	*CHILD_ERROR
 	*OS_ERROR
 	*ERRNO
+	*EXTENDED_OS_ERROR
 	*EVAL_ERROR
 	*PROCESS_ID
 	*PID
@@ -88,18 +121,33 @@ sub import {
 	*BASETIME
 	*WARNING
 	*EXECUTABLE_NAME
+	*OSNAME
+	*LAST_REGEXP_CODE_RESULT
+	*EXCEPTIONS_BEING_CAUGHT
+	*LAST_SUBMATCH_RESULT
+	@LAST_MATCH_START
+	@LAST_MATCH_END
 );
 
-# The ground of all being.
+
+@MATCH_EXPORT = qw(
+	*MATCH
+	*PREMATCH
+	*POSTMATCH
+);
+
+@COMPLETE_EXPORT = ( @MINIMAL_EXPORT, @MATCH_EXPORT ) ;
+
+# The ground of all being. @ARG is deprecated (5.005 makes @_ lexical)
 
 	*ARG					= *_	;
 
 # Matching.
 
-	*MATCH					= *&	;
-	*PREMATCH				= *`	;
-	*POSTMATCH				= *'	;
 	*LAST_PAREN_MATCH			= *+	;
+	*LAST_SUBMATCH_RESULT			= *^N ;
+	*LAST_MATCH_START			= *-{ARRAY} ;
+	*LAST_MATCH_END				= *+{ARRAY} ;
 
 # Input.
 
@@ -137,6 +185,9 @@ sub import {
 	*CHILD_ERROR				= *?	;
 	*OS_ERROR				= *!	;
 	    *ERRNO				= *!	;
+	*OS_ERROR				= *!	;
+	    *ERRNO				= *!	;
+	*EXTENDED_OS_ERROR			= *^E	;
 	*EVAL_ERROR				= *@	;
 
 # Process info.
@@ -155,20 +206,24 @@ sub import {
 
 # Internals.
 
-	*PERL_VERSION				= *]	;
+	*PERL_VERSION				= *^V	;
 	*ACCUMULATOR				= *^A	;
+	*COMPILING				= *^C	;
 	*DEBUGGING				= *^D	;
 	*SYSTEM_FD_MAX				= *^F	;
 	*INPLACE_EDIT				= *^I	;
 	*PERLDB					= *^P	;
+	*LAST_REGEXP_CODE_RESULT		= *^R	;
+	*EXCEPTIONS_BEING_CAUGHT		= *^S	;
 	*BASETIME				= *^T	;
 	*WARNING				= *^W	;
 	*EXECUTABLE_NAME			= *^X	;
+	*OSNAME					= *^O	;
 
 # Deprecated.
 
 #	*ARRAY_BASE				= *[	;
 #	*OFMT					= *#	;
-#	*MULTILINE_MATCHING			= **	;
+#	*OLD_PERL_VERSION			= *]	;
 
 1;