| 1 | package constant; |
| 2 | |
| 3 | use strict; |
| 4 | use 5.005_64; |
| 5 | |
| 6 | our($VERSION, %declared); |
| 7 | $VERSION = '1.01'; |
| 8 | |
| 9 | #======================================================================= |
| 10 | |
| 11 | # Some names are evil choices. |
| 12 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
| 13 | |
| 14 | my %forced_into_main = map +($_, 1), |
| 15 | qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; |
| 16 | |
| 17 | my %forbidden = (%keywords, %forced_into_main); |
| 18 | |
| 19 | #======================================================================= |
| 20 | # import() - import symbols into user's namespace |
| 21 | # |
| 22 | # What we actually do is define a function in the caller's namespace |
| 23 | # which returns the value. The function we create will normally |
| 24 | # be inlined as a constant, thereby avoiding further sub calling |
| 25 | # overhead. |
| 26 | #======================================================================= |
| 27 | sub import { |
| 28 | my $class = shift; |
| 29 | return unless @_; # Ignore 'use constant;' |
| 30 | my $name = shift; |
| 31 | unless (defined $name) { |
| 32 | require Carp; |
| 33 | Carp::croak("Can't use undef as constant name"); |
| 34 | } |
| 35 | my $pkg = caller; |
| 36 | |
| 37 | # Normal constant name |
| 38 | if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { |
| 39 | # Everything is okay |
| 40 | |
| 41 | # Name forced into main, but we're not in main. Fatal. |
| 42 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { |
| 43 | require Carp; |
| 44 | Carp::croak("Constant name '$name' is forced into main::"); |
| 45 | |
| 46 | # Starts with double underscore. Fatal. |
| 47 | } elsif ($name =~ /^__/) { |
| 48 | require Carp; |
| 49 | Carp::croak("Constant name '$name' begins with '__'"); |
| 50 | |
| 51 | # Maybe the name is tolerable |
| 52 | } elsif ($name =~ /^[A-Za-z_]\w*\z/) { |
| 53 | # Then we'll warn only if you've asked for warnings |
| 54 | if ($^W) { |
| 55 | require Carp; |
| 56 | if ($keywords{$name}) { |
| 57 | Carp::carp("Constant name '$name' is a Perl keyword"); |
| 58 | } elsif ($forced_into_main{$name}) { |
| 59 | Carp::carp("Constant name '$name' is " . |
| 60 | "forced into package main::"); |
| 61 | } else { |
| 62 | # Catch-all - what did I miss? If you get this error, |
| 63 | # please let me know what your constant's name was. |
| 64 | # Write to <rootbeer@redcat.com>. Thanks! |
| 65 | Carp::carp("Constant name '$name' has unknown problems"); |
| 66 | } |
| 67 | } |
| 68 | |
| 69 | # Looks like a boolean |
| 70 | # use constant FRED == fred; |
| 71 | } elsif ($name =~ /^[01]?\z/) { |
| 72 | require Carp; |
| 73 | if (@_) { |
| 74 | Carp::croak("Constant name '$name' is invalid"); |
| 75 | } else { |
| 76 | Carp::croak("Constant name looks like boolean value"); |
| 77 | } |
| 78 | |
| 79 | } else { |
| 80 | # Must have bad characters |
| 81 | require Carp; |
| 82 | Carp::croak("Constant name '$name' has invalid characters"); |
| 83 | } |
| 84 | |
| 85 | { |
| 86 | no strict 'refs'; |
| 87 | my $full_name = "${pkg}::$name"; |
| 88 | $declared{$full_name}++; |
| 89 | if (@_ == 1) { |
| 90 | my $scalar = $_[0]; |
| 91 | *$full_name = sub () { $scalar }; |
| 92 | } elsif (@_) { |
| 93 | my @list = @_; |
| 94 | *$full_name = sub () { @list }; |
| 95 | } else { |
| 96 | *$full_name = sub () { }; |
| 97 | } |
| 98 | } |
| 99 | |
| 100 | } |
| 101 | |
| 102 | 1; |
| 103 | |
| 104 | __END__ |
| 105 | |
| 106 | =head1 NAME |
| 107 | |
| 108 | constant - Perl pragma to declare constants |
| 109 | |
| 110 | =head1 SYNOPSIS |
| 111 | |
| 112 | use constant BUFFER_SIZE => 4096; |
| 113 | use constant ONE_YEAR => 365.2425 * 24 * 60 * 60; |
| 114 | use constant PI => 4 * atan2 1, 1; |
| 115 | use constant DEBUGGING => 0; |
| 116 | use constant ORACLE => 'oracle@cs.indiana.edu'; |
| 117 | use constant USERNAME => scalar getpwuid($<); |
| 118 | use constant USERINFO => getpwuid($<); |
| 119 | |
| 120 | sub deg2rad { PI * $_[0] / 180 } |
| 121 | |
| 122 | print "This line does nothing" unless DEBUGGING; |
| 123 | |
| 124 | # references can be constants |
| 125 | use constant CHASH => { foo => 42 }; |
| 126 | use constant CARRAY => [ 1,2,3,4 ]; |
| 127 | use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; |
| 128 | use constant CCODE => sub { "bite $_[0]\n" }; |
| 129 | |
| 130 | print CHASH->{foo}; |
| 131 | print CARRAY->[$i]; |
| 132 | print CPSEUDOHASH->{foo}; |
| 133 | print CCODE->("me"); |
| 134 | print CHASH->[10]; # compile-time error |
| 135 | |
| 136 | =head1 DESCRIPTION |
| 137 | |
| 138 | This will declare a symbol to be a constant with the given scalar |
| 139 | or list value. |
| 140 | |
| 141 | When you declare a constant such as C<PI> using the method shown |
| 142 | above, each machine your script runs upon can have as many digits |
| 143 | of accuracy as it can use. Also, your program will be easier to |
| 144 | read, more likely to be maintained (and maintained correctly), and |
| 145 | far less likely to send a space probe to the wrong planet because |
| 146 | nobody noticed the one equation in which you wrote C<3.14195>. |
| 147 | |
| 148 | =head1 NOTES |
| 149 | |
| 150 | The value or values are evaluated in a list context. You may override |
| 151 | this with C<scalar> as shown above. |
| 152 | |
| 153 | These constants do not directly interpolate into double-quotish |
| 154 | strings, although you may do so indirectly. (See L<perlref> for |
| 155 | details about how this works.) |
| 156 | |
| 157 | print "The value of PI is @{[ PI ]}.\n"; |
| 158 | |
| 159 | List constants are returned as lists, not as arrays. |
| 160 | |
| 161 | $homedir = USERINFO[7]; # WRONG |
| 162 | $homedir = (USERINFO)[7]; # Right |
| 163 | |
| 164 | The use of all caps for constant names is merely a convention, |
| 165 | although it is recommended in order to make constants stand out |
| 166 | and to help avoid collisions with other barewords, keywords, and |
| 167 | subroutine names. Constant names must begin with a letter or |
| 168 | underscore. Names beginning with a double underscore are reserved. Some |
| 169 | poor choices for names will generate warnings, if warnings are enabled at |
| 170 | compile time. |
| 171 | |
| 172 | Constant symbols are package scoped (rather than block scoped, as |
| 173 | C<use strict> is). That is, you can refer to a constant from package |
| 174 | Other as C<Other::CONST>. |
| 175 | |
| 176 | As with all C<use> directives, defining a constant happens at |
| 177 | compile time. Thus, it's probably not correct to put a constant |
| 178 | declaration inside of a conditional statement (like C<if ($foo) |
| 179 | { use constant ... }>). |
| 180 | |
| 181 | Omitting the value for a symbol gives it the value of C<undef> in |
| 182 | a scalar context or the empty list, C<()>, in a list context. This |
| 183 | isn't so nice as it may sound, though, because in this case you |
| 184 | must either quote the symbol name, or use a big arrow, (C<=E<gt>>), |
| 185 | with nothing to point to. It is probably best to declare these |
| 186 | explicitly. |
| 187 | |
| 188 | use constant UNICORNS => (); |
| 189 | use constant LOGFILE => undef; |
| 190 | |
| 191 | The result from evaluating a list constant in a scalar context is |
| 192 | not documented, and is B<not> guaranteed to be any particular value |
| 193 | in the future. In particular, you should not rely upon it being |
| 194 | the number of elements in the list, especially since it is not |
| 195 | B<necessarily> that value in the current implementation. |
| 196 | |
| 197 | Magical values, tied values, and references can be made into |
| 198 | constants at compile time, allowing for way cool stuff like this. |
| 199 | (These error numbers aren't totally portable, alas.) |
| 200 | |
| 201 | use constant E2BIG => ($! = 7); |
| 202 | print E2BIG, "\n"; # something like "Arg list too long" |
| 203 | print 0+E2BIG, "\n"; # "7" |
| 204 | |
| 205 | Dereferencing constant references incorrectly (such as using an array |
| 206 | subscript on a constant hash reference, or vice versa) will be trapped at |
| 207 | compile time. |
| 208 | |
| 209 | In the rare case in which you need to discover at run time whether a |
| 210 | particular constant has been declared via this module, you may use |
| 211 | this function to examine the hash C<%constant::declared>. If the given |
| 212 | constant name does not include a package name, the current package is |
| 213 | used. |
| 214 | |
| 215 | sub declared ($) { |
| 216 | use constant 1.01; # don't omit this! |
| 217 | my $name = shift; |
| 218 | $name =~ s/^::/main::/; |
| 219 | my $pkg = caller; |
| 220 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; |
| 221 | $constant::declared{$full_name}; |
| 222 | } |
| 223 | |
| 224 | =head1 TECHNICAL NOTE |
| 225 | |
| 226 | In the current implementation, scalar constants are actually |
| 227 | inlinable subroutines. As of version 5.004 of Perl, the appropriate |
| 228 | scalar constant is inserted directly in place of some subroutine |
| 229 | calls, thereby saving the overhead of a subroutine call. See |
| 230 | L<perlsub/"Constant Functions"> for details about how and when this |
| 231 | happens. |
| 232 | |
| 233 | =head1 BUGS |
| 234 | |
| 235 | In the current version of Perl, list constants are not inlined |
| 236 | and some symbols may be redefined without generating a warning. |
| 237 | |
| 238 | It is not possible to have a subroutine or keyword with the same |
| 239 | name as a constant in the same package. This is probably a Good Thing. |
| 240 | |
| 241 | A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT |
| 242 | ENV INC SIG> is not allowed anywhere but in package C<main::>, for |
| 243 | technical reasons. |
| 244 | |
| 245 | Even though a reference may be declared as a constant, the reference may |
| 246 | point to data which may be changed, as this code shows. |
| 247 | |
| 248 | use constant CARRAY => [ 1,2,3,4 ]; |
| 249 | print CARRAY->[1]; |
| 250 | CARRAY->[1] = " be changed"; |
| 251 | print CARRAY->[1]; |
| 252 | |
| 253 | Unlike constants in some languages, these cannot be overridden |
| 254 | on the command line or via environment variables. |
| 255 | |
| 256 | You can get into trouble if you use constants in a context which |
| 257 | automatically quotes barewords (as is true for any subroutine call). |
| 258 | For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will |
| 259 | be interpreted as a string. Use C<$hash{CONSTANT()}> or |
| 260 | C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from |
| 261 | kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword |
| 262 | immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'> |
| 263 | (or simply use a comma in place of the big arrow) instead of |
| 264 | C<CONSTANT =E<gt> 'value'>. |
| 265 | |
| 266 | =head1 AUTHOR |
| 267 | |
| 268 | Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from |
| 269 | many other folks. |
| 270 | |
| 271 | =head1 COPYRIGHT |
| 272 | |
| 273 | Copyright (C) 1997, 1999 Tom Phoenix |
| 274 | |
| 275 | This module is free software; you can redistribute it or modify it |
| 276 | under the same terms as Perl itself. |
| 277 | |
| 278 | =cut |