X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FEnglish.pm;h=538336877dc31304992c1c47f4906c7e3bf3d93a;hb=5290524f8b52822096b01140005d681d126b507d;hp=ba89b164b5ef60ce7a45bec93b0c9ec9a095e7fb;hpb=2304df62caa7d9be70e8b8bcdb454e139c9c103d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/English.pm b/lib/English.pm
index ba89b16..5383368 100644
--- a/lib/English.pm
+++ b/lib/English.pm
@@ -1,70 +1,151 @@
 package English;
 
+our $VERSION = '1.00';
+
 require Exporter;
 @ISA = (Exporter);
 
-@EXPORT = qw(
+=head1 NAME
+
+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/) { ... }
+
+=head1 DESCRIPTION
+
+This module provides aliases for the built-in variables whose
+names no one seems to like to read.  Variables with side-effects
+which get triggered just by accessing them (like $0) will still 
+be affected.
+
+For those variables that have an B<awk> version, both long
+and short English alternatives are provided.  For example, 
+the C<$/> variable can be referred to either $RS or 
+$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
+
+no warnings;
+
+my $globbed_match ;
+
+# Grandfather $NAME import
+sub import {
+    my $this = shift;
+    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);
+}
+
+@MINIMAL_EXPORT = qw(
 	*ARG
-	$MATCH
-	$PREMATCH
-	$POSTMATCH
-	$LAST_PAREN_MATCH
-	$INPUT_LINE_NUMBER
-	$NR
-	$INPUT_RECORD_SEPARATOR
-	$RS
-	$OUTPUT_AUTOFLUSH
-	$OUTPUT_FIELD_SEPARATOR
-	$OFS
-	$OUTPUT_RECORD_SEPARATOR
-	$ORS
-	$LIST_SEPARATOR
-	$SUBSCRIPT_SEPARATOR
-	$SUBSEP
-	$FORMAT_PAGE_NUMBER
-	$FORMAT_LINES_PER_PAGE
-	$FORMAT_LINES_LEFT
-	$FORMAT_NAME
-	$FORMAT_TOP_NAME
-	$FORMAT_LINE_BREAK_CHARACTERS
-	$FORMAT_FORMFEED
-	$CHILD_ERROR
-	$OS_ERROR
-	$EVAL_ERROR
-	$PROCESS_ID
-	$PID
-	$REAL_USER_ID
-	$UID
-	$EFFECTIVE_USER_ID
-	$EUID
-	$REAL_GROUP_ID
-	$GID
-	$EFFECTIVE_GROUP_ID
-	$EGID
-	$PROGRAM_NAME
-	$PERL_VERSION
-	$DEBUGGING
-	$SYSTEM_FD_MAX
-	$INPLACE_EDIT
-	$PERLDB
-	$BASETIME
-	$WARNING
-	$EXECUTABLE_NAME
-	$ARRAY_BASE
-	$OFMT
-	$MULTILINE_MATCHING
+	*LAST_PAREN_MATCH
+	*INPUT_LINE_NUMBER
+	*NR
+	*INPUT_RECORD_SEPARATOR
+	*RS
+	*OUTPUT_AUTOFLUSH
+	*OUTPUT_FIELD_SEPARATOR
+	*OFS
+	*OUTPUT_RECORD_SEPARATOR
+	*ORS
+	*LIST_SEPARATOR
+	*SUBSCRIPT_SEPARATOR
+	*SUBSEP
+	*FORMAT_PAGE_NUMBER
+	*FORMAT_LINES_PER_PAGE
+	*FORMAT_LINES_LEFT
+	*FORMAT_NAME
+	*FORMAT_TOP_NAME
+	*FORMAT_LINE_BREAK_CHARACTERS
+	*FORMAT_FORMFEED
+	*CHILD_ERROR
+	*OS_ERROR
+	*ERRNO
+	*EXTENDED_OS_ERROR
+	*EVAL_ERROR
+	*PROCESS_ID
+	*PID
+	*REAL_USER_ID
+	*UID
+	*EFFECTIVE_USER_ID
+	*EUID
+	*REAL_GROUP_ID
+	*GID
+	*EFFECTIVE_GROUP_ID
+	*EGID
+	*PROGRAM_NAME
+	*PERL_VERSION
+	*ACCUMULATOR
+	*DEBUGGING
+	*SYSTEM_FD_MAX
+	*INPLACE_EDIT
+	*PERLDB
+	*BASETIME
+	*WARNING
+	*EXECUTABLE_NAME
+	*OSNAME
+	*LAST_REGEXP_CODE_RESULT
+	*EXCEPTIONS_BEING_CAUGHT
+	@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_MATCH_START			= \@- ;
+	*LAST_MATCH_END				= \@+ ;
 
 # Input.
 
@@ -101,6 +182,10 @@ require Exporter;
 
 	*CHILD_ERROR				= \$?	;
 	*OS_ERROR				= \$!	;
+	    *ERRNO				= \$!	;
+	*OS_ERROR				= \%!	;
+	    *ERRNO				= \%!	;
+	*EXTENDED_OS_ERROR			= \$^E	;
 	*EVAL_ERROR				= \$@	;
 
 # Process info.
@@ -119,19 +204,25 @@ require Exporter;
 
 # 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			= \$*	;
+#	*ARRAY_BASE				= \$[	;
+#	*OFMT					= \$#	;
+#	*MULTILINE_MATCHING			= \$*	;
+#	*OLD_PERL_VERSION			= \$]	;
 
 1;