lib/English.pm

   1 package English;
   2
   3 our $VERSION = '1.08';
   4
   5 require Exporter;
   6 @ISA = qw(Exporter);
   7
   8 =head1 NAME
   9
  10 English - use nice English (or awk) names for ugly punctuation variables
  11
  12 =head1 SYNOPSIS
  13
  14     use English;
  15     use English qw( -no_match_vars ) ;  # Avoids regex performance
  16                                         # penalty in perl 5.16 and
  17                                         # earlier
  18     ...
  19     if ($ERRNO =~ /denied/) { ... }
  20
  21 =head1 DESCRIPTION
  22
  23 This module provides aliases for the built-in variables whose
  24 names no one seems to like to read.  Variables with side-effects
  25 which get triggered just by accessing them (like $0) will still
  26 be affected.
  27
  28 For those variables that have an B<awk> version, both long
  29 and short English alternatives are provided.  For example,
  30 the C<$/> variable can be referred to either $RS or
  31 $INPUT_RECORD_SEPARATOR if you are using the English module.
  32
  33 See L<perlvar> for a complete list of these.
  34
  35 =head1 PERFORMANCE
  36
  37 NOTE: This was fixed in perl 5.20.  Mentioning these three variables no
  38 longer makes a speed difference.  This section still applies if your code
  39 is to run on perl 5.18 or earlier.
  40
  41 This module can provoke sizeable inefficiencies for regular expressions,
  42 due to unfortunate implementation details.  If performance matters in
  43 your application and you don't need $PREMATCH, $MATCH, or $POSTMATCH,
  44 try doing
  45
  46    use English qw( -no_match_vars ) ;
  47
  48 .  B<It is especially important to do this in modules to avoid penalizing
  49 all applications which use them.>
  50
  51 =cut
  52
  53 no warnings;
  54
  55 my $globbed_match ;
  56
  57 # Grandfather $NAME import
  58 sub import {
  59     my $this = shift;
  60     my @list = grep { ! /^-no_match_vars$/ } @_ ;
  61     local $Exporter::ExportLevel = 1;
  62     if ( @_ == @list ) {
  63         *EXPORT = \@COMPLETE_EXPORT ;
  64         $globbed_match ||= (
  65             eval q{
  66                 *MATCH                          = *&    ;
  67                 *PREMATCH                       = *`    ;
  68                 *POSTMATCH                      = *'    ;
  69                 1 ;
  70                }
  71             || do {
  72                 require Carp ;
  73                 Carp::croak("Can't create English for match leftovers: $@") ;
  74             }
  75         ) ;
  76     }
  77     else {
  78         *EXPORT = \@MINIMAL_EXPORT ;
  79     }
  80     Exporter::import($this,grep {s/^\$/*/} @list);
  81 }
  82
  83 @MINIMAL_EXPORT = qw(
  84         *ARG
  85         *LAST_PAREN_MATCH
  86         *INPUT_LINE_NUMBER
  87         *NR
  88         *INPUT_RECORD_SEPARATOR
  89         *RS
  90         *OUTPUT_AUTOFLUSH
  91         *OUTPUT_FIELD_SEPARATOR
  92         *OFS
  93         *OUTPUT_RECORD_SEPARATOR
  94         *ORS
  95         *LIST_SEPARATOR
  96         *SUBSCRIPT_SEPARATOR
  97         *SUBSEP
  98         *FORMAT_PAGE_NUMBER
  99         *FORMAT_LINES_PER_PAGE
 100         *FORMAT_LINES_LEFT
 101         *FORMAT_NAME
 102         *FORMAT_TOP_NAME
 103         *FORMAT_LINE_BREAK_CHARACTERS
 104         *FORMAT_FORMFEED
 105         *CHILD_ERROR
 106         *OS_ERROR
 107         *ERRNO
 108         *EXTENDED_OS_ERROR
 109         *EVAL_ERROR
 110         *PROCESS_ID
 111         *PID
 112         *REAL_USER_ID
 113         *UID
 114         *EFFECTIVE_USER_ID
 115         *EUID
 116         *REAL_GROUP_ID
 117         *GID
 118         *EFFECTIVE_GROUP_ID
 119         *EGID
 120         *PROGRAM_NAME
 121         *PERL_VERSION
 122         *ACCUMULATOR
 123         *COMPILING
 124         *DEBUGGING
 125         *SYSTEM_FD_MAX
 126         *INPLACE_EDIT
 127         *PERLDB
 128         *BASETIME
 129         *WARNING
 130         *EXECUTABLE_NAME
 131         *OSNAME
 132         *LAST_REGEXP_CODE_RESULT
 133         *EXCEPTIONS_BEING_CAUGHT
 134         *LAST_SUBMATCH_RESULT
 135         @LAST_MATCH_START
 136         @LAST_MATCH_END
 137 );
 138
 139
 140 @MATCH_EXPORT = qw(
 141         *MATCH
 142         *PREMATCH
 143         *POSTMATCH
 144 );
 145
 146 @COMPLETE_EXPORT = ( @MINIMAL_EXPORT, @MATCH_EXPORT ) ;
 147
 148 # The ground of all being.
 149
 150         *ARG                                    = *_    ;
 151
 152 # Matching.
 153
 154         *LAST_PAREN_MATCH                       = *+    ;
 155         *LAST_SUBMATCH_RESULT                   = *^N ;
 156         *LAST_MATCH_START                       = *-{ARRAY} ;
 157         *LAST_MATCH_END                         = *+{ARRAY} ;
 158
 159 # Input.
 160
 161         *INPUT_LINE_NUMBER                      = *.    ;
 162             *NR                                 = *.    ;
 163         *INPUT_RECORD_SEPARATOR                 = */    ;
 164             *RS                                 = */    ;
 165
 166 # Output.
 167
 168         *OUTPUT_AUTOFLUSH                       = *|    ;
 169         *OUTPUT_FIELD_SEPARATOR                 = *,    ;
 170             *OFS                                = *,    ;
 171         *OUTPUT_RECORD_SEPARATOR                = *\    ;
 172             *ORS                                = *\    ;
 173
 174 # Interpolation "constants".
 175
 176         *LIST_SEPARATOR                         = *"    ;
 177         *SUBSCRIPT_SEPARATOR                    = *;    ;
 178             *SUBSEP                             = *;    ;
 179
 180 # Formats
 181
 182         *FORMAT_PAGE_NUMBER                     = *%    ;
 183         *FORMAT_LINES_PER_PAGE                  = *=    ;
 184         *FORMAT_LINES_LEFT                      = *-    ;
 185         *FORMAT_NAME                            = *~    ;
 186         *FORMAT_TOP_NAME                        = *^    ;
 187         *FORMAT_LINE_BREAK_CHARACTERS           = *:    ;
 188         *FORMAT_FORMFEED                        = *^L   ;
 189
 190 # Error status.
 191
 192         *CHILD_ERROR                            = *?    ;
 193         *OS_ERROR                               = *!    ;
 194             *ERRNO                              = *!    ;
 195         *OS_ERROR                               = *!    ;
 196             *ERRNO                              = *!    ;
 197         *EXTENDED_OS_ERROR                      = *^E   ;
 198         *EVAL_ERROR                             = *@    ;
 199
 200 # Process info.
 201
 202         *PROCESS_ID                             = *$    ;
 203             *PID                                = *$    ;
 204         *REAL_USER_ID                           = *<    ;
 205             *UID                                = *<    ;
 206         *EFFECTIVE_USER_ID                      = *>    ;
 207             *EUID                               = *>    ;
 208         *REAL_GROUP_ID                          = *(    ;
 209             *GID                                = *(    ;
 210         *EFFECTIVE_GROUP_ID                     = *)    ;
 211             *EGID                               = *)    ;
 212         *PROGRAM_NAME                           = *0    ;
 213
 214 # Internals.
 215
 216         *PERL_VERSION                           = *^V   ;
 217         *ACCUMULATOR                            = *^A   ;
 218         *COMPILING                              = *^C   ;
 219         *DEBUGGING                              = *^D   ;
 220         *SYSTEM_FD_MAX                          = *^F   ;
 221         *INPLACE_EDIT                           = *^I   ;
 222         *PERLDB                                 = *^P   ;
 223         *LAST_REGEXP_CODE_RESULT                = *^R   ;
 224         *EXCEPTIONS_BEING_CAUGHT                = *^S   ;
 225         *BASETIME                               = *^T   ;
 226         *WARNING                                = *^W   ;
 227         *EXECUTABLE_NAME                        = *^X   ;
 228         *OSNAME                                 = *^O   ;
 229
 230 # Deprecated.
 231
 232 #       *ARRAY_BASE                             = *[    ;
 233 #       *OFMT                                   = *#    ;
 234 #       *OLD_PERL_VERSION                       = *]    ;
 235
 236 1;