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