Commit | Line | Data |
54310121 |
1 | package constant; |
6515510f |
2 | use 5.005; |
83763826 |
3 | use strict; |
d3a7d8c7 |
4 | use warnings::register; |
17f410f9 |
5 | |
6515510f |
6 | use vars qw($VERSION %declared); |
7064c127 |
7 | $VERSION = '1.19'; |
83763826 |
8 | |
9 | #======================================================================= |
10 | |
83763826 |
11 | # Some names are evil choices. |
83b99c4f |
12 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
13 | $keywords{UNITCHECK}++ if $] > 5.009; |
83763826 |
14 | |
15 | my %forced_into_main = map +($_, 1), |
16 | qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; |
17 | |
18 | my %forbidden = (%keywords, %forced_into_main); |
19 | |
672c0ce9 |
20 | my $str_end = $] >= 5.006 ? "\\z" : "\\Z"; |
21 | my $normal_constant_name = qr/^_?[^\W_0-9]\w*$str_end/; |
22 | my $tolerable = qr/^[A-Za-z_]\w*$str_end/; |
23 | my $boolean = qr/^[01]?$str_end/; |
24 | |
c5764f70 |
25 | BEGIN { |
26 | # We'd like to do use constant _CAN_PCS => $] > 5.009002 |
27 | # but that's a bit tricky before we load the constant module :-) |
28 | # By doing this, we save 1 run time check for *every* call to import. |
29 | no strict 'refs'; |
30 | my $const = $] > 5.009002; |
31 | *_CAN_PCS = sub () {$const}; |
32 | } |
33 | |
83763826 |
34 | #======================================================================= |
35 | # import() - import symbols into user's namespace |
36 | # |
37 | # What we actually do is define a function in the caller's namespace |
38 | # which returns the value. The function we create will normally |
39 | # be inlined as a constant, thereby avoiding further sub calling |
40 | # overhead. |
41 | #======================================================================= |
42 | sub import { |
43 | my $class = shift; |
44 | return unless @_; # Ignore 'use constant;' |
b35226bb |
45 | my $constants; |
3cb88d13 |
46 | my $multiple = ref $_[0]; |
39a108ce |
47 | my $pkg = caller; |
f7fd2659 |
48 | my $flush_mro; |
e040ff70 |
49 | my $symtab; |
50 | |
c5764f70 |
51 | if (_CAN_PCS) { |
e040ff70 |
52 | no strict 'refs'; |
53 | $symtab = \%{$pkg . '::'}; |
54 | }; |
3cb88d13 |
55 | |
56 | if ( $multiple ) { |
57 | if (ref $_[0] ne 'HASH') { |
58 | require Carp; |
59 | Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'"); |
60 | } |
b35226bb |
61 | $constants = shift; |
3cb88d13 |
62 | } else { |
b35226bb |
63 | $constants->{+shift} = undef; |
83763826 |
64 | } |
3cb88d13 |
65 | |
b35226bb |
66 | foreach my $name ( keys %$constants ) { |
3cb88d13 |
67 | unless (defined $name) { |
68 | require Carp; |
69 | Carp::croak("Can't use undef as constant name"); |
70 | } |
3cb88d13 |
71 | |
72 | # Normal constant name |
672c0ce9 |
73 | if ($name =~ $normal_constant_name and !$forbidden{$name}) { |
3cb88d13 |
74 | # Everything is okay |
75 | |
76 | # Name forced into main, but we're not in main. Fatal. |
77 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { |
78 | require Carp; |
79 | Carp::croak("Constant name '$name' is forced into main::"); |
80 | |
81 | # Starts with double underscore. Fatal. |
82 | } elsif ($name =~ /^__/) { |
83 | require Carp; |
84 | Carp::croak("Constant name '$name' begins with '__'"); |
85 | |
86 | # Maybe the name is tolerable |
672c0ce9 |
87 | } elsif ($name =~ $tolerable) { |
3cb88d13 |
88 | # Then we'll warn only if you've asked for warnings |
89 | if (warnings::enabled()) { |
90 | if ($keywords{$name}) { |
91 | warnings::warn("Constant name '$name' is a Perl keyword"); |
92 | } elsif ($forced_into_main{$name}) { |
93 | warnings::warn("Constant name '$name' is " . |
94 | "forced into package main::"); |
3cb88d13 |
95 | } |
96 | } |
97 | |
98 | # Looks like a boolean |
99 | # use constant FRED == fred; |
672c0ce9 |
100 | } elsif ($name =~ $boolean) { |
3cb88d13 |
101 | require Carp; |
102 | if (@_) { |
103 | Carp::croak("Constant name '$name' is invalid"); |
83763826 |
104 | } else { |
3cb88d13 |
105 | Carp::croak("Constant name looks like boolean value"); |
83763826 |
106 | } |
83763826 |
107 | |
83763826 |
108 | } else { |
3cb88d13 |
109 | # Must have bad characters |
110 | require Carp; |
111 | Carp::croak("Constant name '$name' has invalid characters"); |
83763826 |
112 | } |
113 | |
3cb88d13 |
114 | { |
115 | no strict 'refs'; |
116 | my $full_name = "${pkg}::$name"; |
117 | $declared{$full_name}++; |
e040ff70 |
118 | if ($multiple || @_ == 1) { |
119 | my $scalar = $multiple ? $constants->{$name} : $_[0]; |
a8ae8fee |
120 | # The constant serves to optimise this entire block out on |
121 | # 5.8 and earlier. |
122 | if (_CAN_PCS && $symtab && !exists $symtab->{$name}) { |
e040ff70 |
123 | # No typeglob yet, so we can use a reference as space- |
124 | # efficient proxy for a constant subroutine |
125 | # The check in Perl_ck_rvconst knows that inlinable |
126 | # constants from cv_const_sv are read only. So we have to: |
127 | Internals::SvREADONLY($scalar, 1); |
128 | $symtab->{$name} = \$scalar; |
f7fd2659 |
129 | ++$flush_mro; |
3cb88d13 |
130 | } else { |
e040ff70 |
131 | *$full_name = sub () { $scalar }; |
3cb88d13 |
132 | } |
e040ff70 |
133 | } elsif (@_) { |
134 | my @list = @_; |
135 | *$full_name = sub () { @list }; |
136 | } else { |
137 | *$full_name = sub () { }; |
3cb88d13 |
138 | } |
83763826 |
139 | } |
140 | } |
f7fd2659 |
141 | # Flush the cache exactly once if we make any direct symbol table changes. |
a8ae8fee |
142 | mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro; |
83763826 |
143 | } |
144 | |
145 | 1; |
146 | |
147 | __END__ |
54310121 |
148 | |
149 | =head1 NAME |
150 | |
151 | constant - Perl pragma to declare constants |
152 | |
153 | =head1 SYNOPSIS |
154 | |
a747501d |
155 | use constant PI => 4 * atan2(1, 1); |
156 | use constant DEBUG => 0; |
157 | |
158 | print "Pi equals ", PI, "...\n" if DEBUG; |
159 | |
3cb88d13 |
160 | use constant { |
a747501d |
161 | SEC => 0, |
162 | MIN => 1, |
163 | HOUR => 2, |
164 | MDAY => 3, |
165 | MON => 4, |
166 | YEAR => 5, |
167 | WDAY => 6, |
168 | YDAY => 7, |
169 | ISDST => 8, |
3cb88d13 |
170 | }; |
171 | |
a747501d |
172 | use constant WEEKDAYS => qw( |
173 | Sunday Monday Tuesday Wednesday Thursday Friday Saturday |
174 | ); |
175 | |
176 | print "Today is ", (WEEKDAYS)[ (localtime)[WDAY] ], ".\n"; |
177 | |
54310121 |
178 | =head1 DESCRIPTION |
179 | |
6515510f |
180 | This pragma allows you to declare constants at compile-time. |
54310121 |
181 | |
182 | When you declare a constant such as C<PI> using the method shown |
183 | above, each machine your script runs upon can have as many digits |
184 | of accuracy as it can use. Also, your program will be easier to |
185 | read, more likely to be maintained (and maintained correctly), and |
186 | far less likely to send a space probe to the wrong planet because |
187 | nobody noticed the one equation in which you wrote C<3.14195>. |
188 | |
d3383c75 |
189 | When a constant is used in an expression, Perl replaces it with its |
a747501d |
190 | value at compile time, and may then optimize the expression further. |
191 | In particular, any code in an C<if (CONSTANT)> block will be optimized |
192 | away if the constant is false. |
193 | |
54310121 |
194 | =head1 NOTES |
195 | |
a747501d |
196 | As with all C<use> directives, defining a constant happens at |
197 | compile time. Thus, it's probably not correct to put a constant |
198 | declaration inside of a conditional statement (like C<if ($foo) |
199 | { use constant ... }>). |
54310121 |
200 | |
a747501d |
201 | Constants defined using this module cannot be interpolated into |
202 | strings like variables. However, concatenation works just fine: |
54310121 |
203 | |
a747501d |
204 | print "Pi equals PI...\n"; # WRONG: does not expand "PI" |
205 | print "Pi equals ".PI."...\n"; # right |
54310121 |
206 | |
a747501d |
207 | Even though a reference may be declared as a constant, the reference may |
208 | point to data which may be changed, as this code shows. |
209 | |
210 | use constant ARRAY => [ 1,2,3,4 ]; |
211 | print ARRAY->[1]; |
212 | ARRAY->[1] = " be changed"; |
213 | print ARRAY->[1]; |
214 | |
215 | Dereferencing constant references incorrectly (such as using an array |
216 | subscript on a constant hash reference, or vice versa) will be trapped at |
217 | compile time. |
54310121 |
218 | |
a747501d |
219 | Constants belong to the package they are defined in. To refer to a |
220 | constant defined in another package, specify the full package name, as |
221 | in C<Some::Package::CONSTANT>. Constants may be exported by modules, |
222 | and may also be called as either class or instance methods, that is, |
223 | as C<< Some::Package->CONSTANT >> or as C<< $obj->CONSTANT >> where |
224 | C<$obj> is an instance of C<Some::Package>. Subclasses may define |
225 | their own constants to override those in their base class. |
54310121 |
226 | |
227 | The use of all caps for constant names is merely a convention, |
228 | although it is recommended in order to make constants stand out |
229 | and to help avoid collisions with other barewords, keywords, and |
83763826 |
230 | subroutine names. Constant names must begin with a letter or |
231 | underscore. Names beginning with a double underscore are reserved. Some |
232 | poor choices for names will generate warnings, if warnings are enabled at |
233 | compile time. |
54310121 |
234 | |
a747501d |
235 | =head2 List constants |
54310121 |
236 | |
a747501d |
237 | Constants may be lists of more (or less) than one value. A constant |
238 | with no values evaluates to C<undef> in scalar context. Note that |
239 | constants with more than one value do I<not> return their last value in |
240 | scalar context as one might expect. They currently return the number |
241 | of values, but B<this may change in the future>. Do not use constants |
242 | with multiple values in scalar context. |
3cb88d13 |
243 | |
a747501d |
244 | B<NOTE:> This implies that the expression defining the value of a |
245 | constant is evaluated in list context. This may produce surprises: |
54310121 |
246 | |
a747501d |
247 | use constant TIMESTAMP => localtime; # WRONG! |
248 | use constant TIMESTAMP => scalar localtime; # right |
54310121 |
249 | |
a747501d |
250 | The first line above defines C<TIMESTAMP> as a 9-element list, as |
6515510f |
251 | returned by C<localtime()> in list context. To set it to the string |
252 | returned by C<localtime()> in scalar context, an explicit C<scalar> |
a747501d |
253 | keyword is required. |
54310121 |
254 | |
a747501d |
255 | List constants are lists, not arrays. To index or slice them, they |
256 | must be placed in parentheses. |
54310121 |
257 | |
a747501d |
258 | my @workdays = WEEKDAYS[1 .. 5]; # WRONG! |
259 | my @workdays = (WEEKDAYS)[1 .. 5]; # right |
b0d6893f |
260 | |
a747501d |
261 | =head2 Defining multiple constants at once |
b0d6893f |
262 | |
a747501d |
263 | Instead of writing multiple C<use constant> statements, you may define |
264 | multiple constants in a single statement by giving, instead of the |
265 | constant name, a reference to a hash where the keys are the names of |
266 | the constants to be defined. Obviously, all constants defined using |
267 | this method must have a single value. |
268 | |
269 | use constant { |
270 | FOO => "A single value", |
271 | BAR => "This", "won't", "work!", # Error! |
272 | }; |
273 | |
274 | This is a fundamental limitation of the way hashes are constructed in |
275 | Perl. The error messages produced when this happens will often be |
276 | quite cryptic -- in the worst case there may be none at all, and |
277 | you'll only later find that something is broken. |
278 | |
279 | When defining multiple constants, you cannot use the values of other |
280 | constants defined in the same declaration. This is because the |
281 | calling package doesn't know about any constant within that group |
282 | until I<after> the C<use> statement is finished. |
283 | |
284 | use constant { |
285 | BITMASK => 0xAFBAEBA8, |
286 | NEGMASK => ~BITMASK, # Error! |
287 | }; |
288 | |
289 | =head2 Magic constants |
b0d6893f |
290 | |
291 | Magical values and references can be made into constants at compile |
292 | time, allowing for way cool stuff like this. (These error numbers |
293 | aren't totally portable, alas.) |
54310121 |
294 | |
295 | use constant E2BIG => ($! = 7); |
a747501d |
296 | print E2BIG, "\n"; # something like "Arg list too long" |
297 | print 0+E2BIG, "\n"; # "7" |
54310121 |
298 | |
b0d6893f |
299 | You can't produce a tied constant by giving a tied scalar as the |
300 | value. References to tied variables, however, can be used as |
301 | constants without any problems. |
302 | |
a747501d |
303 | =head1 TECHNICAL NOTES |
b0d6893f |
304 | |
a747501d |
305 | In the current implementation, scalar constants are actually |
306 | inlinable subroutines. As of version 5.004 of Perl, the appropriate |
307 | scalar constant is inserted directly in place of some subroutine |
308 | calls, thereby saving the overhead of a subroutine call. See |
309 | L<perlsub/"Constant Functions"> for details about how and when this |
310 | happens. |
3cb88d13 |
311 | |
83763826 |
312 | In the rare case in which you need to discover at run time whether a |
313 | particular constant has been declared via this module, you may use |
314 | this function to examine the hash C<%constant::declared>. If the given |
315 | constant name does not include a package name, the current package is |
316 | used. |
317 | |
318 | sub declared ($) { |
a747501d |
319 | use constant 1.01; # don't omit this! |
320 | my $name = shift; |
321 | $name =~ s/^::/main::/; |
322 | my $pkg = caller; |
323 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; |
324 | $constant::declared{$full_name}; |
83763826 |
325 | } |
779c5bc9 |
326 | |
6515510f |
327 | =head1 CAVEATS |
54310121 |
328 | |
329 | In the current version of Perl, list constants are not inlined |
330 | and some symbols may be redefined without generating a warning. |
331 | |
a747501d |
332 | It is not possible to have a subroutine or a keyword with the same |
83763826 |
333 | name as a constant in the same package. This is probably a Good Thing. |
334 | |
335 | A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT |
336 | ENV INC SIG> is not allowed anywhere but in package C<main::>, for |
337 | technical reasons. |
338 | |
54310121 |
339 | Unlike constants in some languages, these cannot be overridden |
340 | on the command line or via environment variables. |
341 | |
a3cb178b |
342 | You can get into trouble if you use constants in a context which |
343 | automatically quotes barewords (as is true for any subroutine call). |
344 | For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will |
345 | be interpreted as a string. Use C<$hash{CONSTANT()}> or |
346 | C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from |
a747501d |
347 | kicking in. Similarly, since the C<< => >> operator quotes a bareword |
348 | immediately to its left, you have to say C<< CONSTANT() => 'value' >> |
83763826 |
349 | (or simply use a comma in place of the big arrow) instead of |
a747501d |
350 | C<< CONSTANT => 'value' >>. |
a3cb178b |
351 | |
d3383c75 |
352 | =head1 SEE ALSO |
353 | |
354 | L<Readonly> - Facility for creating read-only scalars, arrays, hashes. |
355 | |
356 | L<Const> - Facility for creating read-only variables. Similar to C<Readonly>, |
357 | but uses C<SvREADONLY> instead of C<tie>. |
358 | |
359 | L<Attribute::Constant> - Make read-only variables via attribute |
360 | |
361 | L<Scalar::Readonly> - Perl extension to the C<SvREADONLY> scalar flag |
362 | |
363 | L<Hash::Util> - A selection of general-utility hash subroutines (mostly |
364 | to lock/unlock keys and values) |
365 | |
6515510f |
366 | =head1 BUGS |
367 | |
368 | Please report any bugs or feature requests via the perlbug(1) utility. |
369 | |
370 | =head1 AUTHORS |
54310121 |
371 | |
83763826 |
372 | Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from |
54310121 |
373 | many other folks. |
374 | |
e1e60e72 |
375 | Multiple constant declarations at once added by Casey West, |
376 | E<lt>F<casey@geeknest.com>E<gt>. |
3cb88d13 |
377 | |
a747501d |
378 | Documentation mostly rewritten by Ilmari Karonen, |
b0d6893f |
379 | E<lt>F<perl@itz.pp.sci.fi>E<gt>. |
380 | |
6515510f |
381 | This program is maintained by the Perl 5 Porters. |
382 | The CPAN distribution is maintained by SE<eacute>bastien Aperghis-Tramoni |
383 | E<lt>F<sebastien@aperghis.net>E<gt>. |
384 | |
d3383c75 |
385 | =head1 COPYRIGHT & LICENSE |
54310121 |
386 | |
83763826 |
387 | Copyright (C) 1997, 1999 Tom Phoenix |
54310121 |
388 | |
389 | This module is free software; you can redistribute it or modify it |
390 | under the same terms as Perl itself. |
391 | |
392 | =cut |