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