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