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