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