From 9e7db0fd3029ee5d3ce957e842a66c057eacd303 Mon Sep 17 00:00:00 2001
From: root <root@jester.slaysys.com>
Date: Thu, 22 Jun 2000 16:33:58 -0400
Subject: [PATCH] A way to avoid English.pm performance hit. Subject: [YAPATCH
 English.pm] My turn to putt again Message-Id:
 <200006230033.UAA05960@jester.slaysys.com>

p4raw-id: //depot/cfgperl@6224
---
 lib/English.pm  | 54 ++++++++++++++++++++++++++++++++++++++++++------------
 t/lib/english.t | 36 +++++++++++++++++++++++++++---------
 2 files changed, 69 insertions(+), 21 deletions(-)

diff --git a/lib/English.pm b/lib/English.pm
index f38c313..1ebc3de 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -9,6 +9,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,29 +28,52 @@ $INPUT_RECORD_SEPARATOR if you are using the English module.
 
 See L<perlvar> for a complete list of these.
 
-=head1 BUGS
+=head1 PERFORMANCE
 
-This module provokes sizeable inefficiencies for regular expressions,
-due to unfortunate implementation details.  If performance matters,
-consider avoiding English.
+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
 
 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
@@ -102,15 +126,21 @@ sub import {
 	@LAST_MATCH_END
 );
 
+
+@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_MATCH_START			= *-{ARRAY} ;
 	*LAST_MATCH_END				= *+{ARRAY} ;
diff --git a/t/lib/english.t b/t/lib/english.t
index dba68db..bcc41e1 100755
--- a/t/lib/english.t
+++ b/t/lib/english.t
@@ -1,9 +1,9 @@
 #!./perl
 
-print "1..16\n";
+print "1..22\n";
 
 BEGIN { unshift @INC, '../lib' }
-use English;
+use English qw( -no_match_vars ) ;
 use Config;
 my $threads = $Config{'use5005threads'} || 0;
 
@@ -17,13 +17,11 @@ sub foo {
 }
 &foo(1);
 
-if ($threads) {
-    $_ = "ok 4\nok 5\nok 6\n";
-} else {
-    $ARG = "ok 4\nok 5\nok 6\n";
-}
-/ok 5\n/;
-print $PREMATCH, $MATCH, $POSTMATCH;
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 4\n" ;
+print ! $MATCH     ? "" : "not ", "ok 5\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 6\n" ;
 
 $OFS = " ";
 $ORS = "\n";
@@ -45,3 +43,23 @@ print $EGID == $) ? "ok 14\n" : "not ok 14\n";
 
 print $PROGRAM_NAME == $0 ? "ok 15\n" : "not ok 15\n";
 print $BASETIME == $^T ? "ok 16\n" : "not ok 16\n";
+
+package B ;
+
+use English ;
+
+"abc" =~ /b/;
+
+print $PREMATCH  ? "" : "not ", "ok 17\n" ;
+print $MATCH     ? "" : "not ", "ok 18\n" ;
+print $POSTMATCH ? "" : "not ", "ok 19\n" ;
+
+package C ;
+
+use English qw( -no_match_vars ) ;
+
+"abc" =~ /b/;
+
+print ! $PREMATCH  ? "" : "not ", "ok 20\n" ;
+print ! $MATCH     ? "" : "not ", "ok 21\n" ;
+print ! $POSTMATCH ? "" : "not ", "ok 22\n" ;
-- 
2.7.4