X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEnglish.pm;h=118a95a0019e9b8eef5217e894aa88ca3f437f8a;hb=a8bf0cad84ba0e8477c2b4b1b02a57dbd376a155;hp=bbb6bd7b280c7a123e4a3419f0a9b1fd200ba0bd;hpb=4318d5a0158916acc059aa8e6af84037cb7296b9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/English.pm b/lib/English.pm index bbb6bd7..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 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 + =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 @@ -90,18 +122,32 @@ sub import { *WARNING *EXECUTABLE_NAME *OSNAME + *LAST_REGEXP_CODE_RESULT + *EXCEPTIONS_BEING_CAUGHT + *LAST_SUBMATCH_RESULT + @LAST_MATCH_START + @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_SUBMATCH_RESULT = *^N ; + *LAST_MATCH_START = *-{ARRAY} ; + *LAST_MATCH_END = *+{ARRAY} ; # Input. @@ -139,6 +185,8 @@ sub import { *CHILD_ERROR = *? ; *OS_ERROR = *! ; *ERRNO = *! ; + *OS_ERROR = *! ; + *ERRNO = *! ; *EXTENDED_OS_ERROR = *^E ; *EVAL_ERROR = *@ ; @@ -158,12 +206,15 @@ 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 ; @@ -173,6 +224,6 @@ sub import { # *ARRAY_BASE = *[ ; # *OFMT = *# ; -# *MULTILINE_MATCHING = ** ; +# *OLD_PERL_VERSION = *] ; 1;