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