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