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