Commit | Line | Data |
---|---|---|
54310121 | 1 | package constant; |
2 | ||
83763826 | 3 | use strict; |
b0d6893f | 4 | use 5.006_00; |
d3a7d8c7 | 5 | use warnings::register; |
17f410f9 GS |
6 | |
7 | our($VERSION, %declared); | |
b0d6893f | 8 | $VERSION = '1.04'; |
83763826 GS |
9 | |
10 | #======================================================================= | |
11 | ||
83763826 | 12 | # Some names are evil choices. |
7d30b5c4 | 13 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
83763826 GS |
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 | #======================================================================= | |
21 | # import() - import symbols into user's namespace | |
22 | # | |
23 | # What we actually do is define a function in the caller's namespace | |
24 | # which returns the value. The function we create will normally | |
25 | # be inlined as a constant, thereby avoiding further sub calling | |
26 | # overhead. | |
27 | #======================================================================= | |
28 | sub import { | |
29 | my $class = shift; | |
30 | return unless @_; # Ignore 'use constant;' | |
3cb88d13 CT |
31 | my %constants = (); |
32 | my $multiple = ref $_[0]; | |
33 | ||
34 | if ( $multiple ) { | |
35 | if (ref $_[0] ne 'HASH') { | |
36 | require Carp; | |
37 | Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'"); | |
38 | } | |
39 | %constants = %{+shift}; | |
40 | } else { | |
41 | $constants{+shift} = undef; | |
83763826 | 42 | } |
3cb88d13 CT |
43 | |
44 | foreach my $name ( keys %constants ) { | |
45 | unless (defined $name) { | |
46 | require Carp; | |
47 | Carp::croak("Can't use undef as constant name"); | |
48 | } | |
49 | my $pkg = caller; | |
50 | ||
51 | # Normal constant name | |
52 | if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { | |
53 | # Everything is okay | |
54 | ||
55 | # Name forced into main, but we're not in main. Fatal. | |
56 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { | |
57 | require Carp; | |
58 | Carp::croak("Constant name '$name' is forced into main::"); | |
59 | ||
60 | # Starts with double underscore. Fatal. | |
61 | } elsif ($name =~ /^__/) { | |
62 | require Carp; | |
63 | Carp::croak("Constant name '$name' begins with '__'"); | |
64 | ||
65 | # Maybe the name is tolerable | |
66 | } elsif ($name =~ /^[A-Za-z_]\w*\z/) { | |
67 | # Then we'll warn only if you've asked for warnings | |
68 | if (warnings::enabled()) { | |
69 | if ($keywords{$name}) { | |
70 | warnings::warn("Constant name '$name' is a Perl keyword"); | |
71 | } elsif ($forced_into_main{$name}) { | |
72 | warnings::warn("Constant name '$name' is " . | |
73 | "forced into package main::"); | |
74 | } else { | |
75 | # Catch-all - what did I miss? If you get this error, | |
76 | # please let me know what your constant's name was. | |
77 | # Write to <rootbeer@redcat.com>. Thanks! | |
78 | warnings::warn("Constant name '$name' has unknown problems"); | |
79 | } | |
80 | } | |
81 | ||
82 | # Looks like a boolean | |
83 | # use constant FRED == fred; | |
84 | } elsif ($name =~ /^[01]?\z/) { | |
85 | require Carp; | |
86 | if (@_) { | |
87 | Carp::croak("Constant name '$name' is invalid"); | |
83763826 | 88 | } else { |
3cb88d13 | 89 | Carp::croak("Constant name looks like boolean value"); |
83763826 | 90 | } |
83763826 | 91 | |
83763826 | 92 | } else { |
3cb88d13 CT |
93 | # Must have bad characters |
94 | require Carp; | |
95 | Carp::croak("Constant name '$name' has invalid characters"); | |
83763826 GS |
96 | } |
97 | ||
3cb88d13 CT |
98 | { |
99 | no strict 'refs'; | |
100 | my $full_name = "${pkg}::$name"; | |
101 | $declared{$full_name}++; | |
102 | if ($multiple) { | |
103 | my $scalar = $constants{$name}; | |
104 | *$full_name = sub () { $scalar }; | |
105 | } else { | |
106 | if (@_ == 1) { | |
107 | my $scalar = $_[0]; | |
108 | *$full_name = sub () { $scalar }; | |
109 | } elsif (@_) { | |
110 | my @list = @_; | |
111 | *$full_name = sub () { @list }; | |
112 | } else { | |
113 | *$full_name = sub () { }; | |
114 | } | |
115 | } | |
83763826 GS |
116 | } |
117 | } | |
83763826 GS |
118 | } |
119 | ||
120 | 1; | |
121 | ||
122 | __END__ | |
54310121 | 123 | |
124 | =head1 NAME | |
125 | ||
126 | constant - Perl pragma to declare constants | |
127 | ||
128 | =head1 SYNOPSIS | |
129 | ||
130 | use constant BUFFER_SIZE => 4096; | |
131 | use constant ONE_YEAR => 365.2425 * 24 * 60 * 60; | |
132 | use constant PI => 4 * atan2 1, 1; | |
133 | use constant DEBUGGING => 0; | |
134 | use constant ORACLE => 'oracle@cs.indiana.edu'; | |
135 | use constant USERNAME => scalar getpwuid($<); | |
136 | use constant USERINFO => getpwuid($<); | |
137 | ||
138 | sub deg2rad { PI * $_[0] / 180 } | |
139 | ||
140 | print "This line does nothing" unless DEBUGGING; | |
141 | ||
83763826 | 142 | # references can be constants |
779c5bc9 GS |
143 | use constant CHASH => { foo => 42 }; |
144 | use constant CARRAY => [ 1,2,3,4 ]; | |
145 | use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; | |
146 | use constant CCODE => sub { "bite $_[0]\n" }; | |
147 | ||
148 | print CHASH->{foo}; | |
149 | print CARRAY->[$i]; | |
150 | print CPSEUDOHASH->{foo}; | |
151 | print CCODE->("me"); | |
83763826 | 152 | print CHASH->[10]; # compile-time error |
779c5bc9 | 153 | |
3cb88d13 CT |
154 | # declaring multiple constants at once |
155 | use constant { | |
156 | BUFFER_SIZE => 4096, | |
157 | ONE_YEAR => 365.2425 * 24 * 60 * 60, | |
158 | PI => 4 * atan2( 1, 1 ), | |
159 | DEBUGGING => 0, | |
160 | ORACLE => 'oracle@cs.indiana.edu', | |
b0d6893f IK |
161 | USERNAME => scalar getpwuid($<), # this works |
162 | USERINFO => getpwuid($<), # THIS IS A BUG! | |
3cb88d13 CT |
163 | }; |
164 | ||
54310121 | 165 | =head1 DESCRIPTION |
166 | ||
167 | This will declare a symbol to be a constant with the given scalar | |
168 | or list value. | |
169 | ||
170 | When you declare a constant such as C<PI> using the method shown | |
171 | above, each machine your script runs upon can have as many digits | |
172 | of accuracy as it can use. Also, your program will be easier to | |
173 | read, more likely to be maintained (and maintained correctly), and | |
174 | far less likely to send a space probe to the wrong planet because | |
175 | nobody noticed the one equation in which you wrote C<3.14195>. | |
176 | ||
177 | =head1 NOTES | |
178 | ||
179 | The value or values are evaluated in a list context. You may override | |
180 | this with C<scalar> as shown above. | |
181 | ||
182 | These constants do not directly interpolate into double-quotish | |
183 | strings, although you may do so indirectly. (See L<perlref> for | |
184 | details about how this works.) | |
185 | ||
186 | print "The value of PI is @{[ PI ]}.\n"; | |
187 | ||
188 | List constants are returned as lists, not as arrays. | |
189 | ||
190 | $homedir = USERINFO[7]; # WRONG | |
191 | $homedir = (USERINFO)[7]; # Right | |
192 | ||
193 | The use of all caps for constant names is merely a convention, | |
194 | although it is recommended in order to make constants stand out | |
195 | and to help avoid collisions with other barewords, keywords, and | |
83763826 GS |
196 | subroutine names. Constant names must begin with a letter or |
197 | underscore. Names beginning with a double underscore are reserved. Some | |
198 | poor choices for names will generate warnings, if warnings are enabled at | |
199 | compile time. | |
54310121 | 200 | |
201 | Constant symbols are package scoped (rather than block scoped, as | |
202 | C<use strict> is). That is, you can refer to a constant from package | |
b0d6893f IK |
203 | Other as C<Other::CONST>. You may also use constants as either class |
204 | or object methods, ie. C<< Other->CONST() >> or C<< $obj->CONST() >>. | |
205 | Such constant methods will be inherited as usual. | |
54310121 | 206 | |
207 | As with all C<use> directives, defining a constant happens at | |
208 | compile time. Thus, it's probably not correct to put a constant | |
209 | declaration inside of a conditional statement (like C<if ($foo) | |
3cb88d13 CT |
210 | { use constant ... }>). When defining multiple constants, you |
211 | cannot use the values of other constants within the same declaration | |
212 | scope. This is because the calling package doesn't know about any | |
213 | constant within that group until I<after> the C<use> statement is | |
214 | finished. | |
215 | ||
216 | use constant { | |
217 | AGE => 20, | |
218 | PERSON => { age => AGE }, # Error! | |
219 | }; | |
220 | [...] | |
221 | use constant PERSON => { age => AGE }; # Right | |
54310121 | 222 | |
b0d6893f IK |
223 | Giving an empty list, C<()>, as the value for a symbol makes it return |
224 | C<undef> in scalar context and the empty list in list context. | |
54310121 | 225 | |
b0d6893f | 226 | use constant UNICORNS => (); |
54310121 | 227 | |
b0d6893f IK |
228 | print "Impossible!\n" if defined UNICORNS; |
229 | my @unicorns = UNICORNS; # there are no unicorns | |
54310121 | 230 | |
b0d6893f IK |
231 | The same effect can be achieved by omitting the value and the big |
232 | arrow entirely, but then the symbol name must be put in quotes. | |
233 | ||
234 | use constant "UNICORNS"; | |
235 | ||
236 | The result from evaluating a list constant with more than one element | |
237 | in a scalar context is not documented, and is B<not> guaranteed to be | |
238 | any particular value in the future. In particular, you should not rely | |
239 | upon it being the number of elements in the list, especially since it | |
240 | is not B<necessarily> that value in the current implementation. | |
241 | ||
242 | Magical values and references can be made into constants at compile | |
243 | time, allowing for way cool stuff like this. (These error numbers | |
244 | aren't totally portable, alas.) | |
54310121 | 245 | |
246 | use constant E2BIG => ($! = 7); | |
247 | print E2BIG, "\n"; # something like "Arg list too long" | |
248 | print 0+E2BIG, "\n"; # "7" | |
249 | ||
b0d6893f IK |
250 | You can't produce a tied constant by giving a tied scalar as the |
251 | value. References to tied variables, however, can be used as | |
252 | constants without any problems. | |
253 | ||
83763826 GS |
254 | Dereferencing constant references incorrectly (such as using an array |
255 | subscript on a constant hash reference, or vice versa) will be trapped at | |
256 | compile time. | |
257 | ||
b0d6893f IK |
258 | When declaring multiple constants, all constant values B<must be |
259 | scalars>. If you accidentally try to use a list with more (or less) | |
260 | than one value, every second value will be treated as a symbol name. | |
261 | ||
262 | use constant { | |
263 | EMPTY => (), # WRONG! | |
264 | MANY => ("foo", "bar", "baz"), # WRONG! | |
265 | }; | |
266 | ||
267 | This will get interpreted as below, which is probably not what you | |
268 | wanted. | |
269 | ||
270 | use constant { | |
271 | EMPTY => "MANY", # oops. | |
272 | foo => "bar", # oops! | |
273 | baz => undef, # OOPS! | |
274 | }; | |
275 | ||
276 | This is a fundamental limitation of the way hashes are constructed in | |
277 | Perl. The error messages produced when this happens will often be | |
278 | quite cryptic -- in the worst case there may be none at all, and | |
279 | you'll only later find that something is broken. | |
3cb88d13 | 280 | |
83763826 GS |
281 | In the rare case in which you need to discover at run time whether a |
282 | particular constant has been declared via this module, you may use | |
283 | this function to examine the hash C<%constant::declared>. If the given | |
284 | constant name does not include a package name, the current package is | |
285 | used. | |
286 | ||
287 | sub declared ($) { | |
288 | use constant 1.01; # don't omit this! | |
289 | my $name = shift; | |
290 | $name =~ s/^::/main::/; | |
291 | my $pkg = caller; | |
292 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; | |
293 | $constant::declared{$full_name}; | |
294 | } | |
779c5bc9 | 295 | |
54310121 | 296 | =head1 TECHNICAL NOTE |
297 | ||
298 | In the current implementation, scalar constants are actually | |
299 | inlinable subroutines. As of version 5.004 of Perl, the appropriate | |
300 | scalar constant is inserted directly in place of some subroutine | |
301 | calls, thereby saving the overhead of a subroutine call. See | |
302 | L<perlsub/"Constant Functions"> for details about how and when this | |
303 | happens. | |
304 | ||
305 | =head1 BUGS | |
306 | ||
307 | In the current version of Perl, list constants are not inlined | |
308 | and some symbols may be redefined without generating a warning. | |
309 | ||
310 | It is not possible to have a subroutine or keyword with the same | |
83763826 GS |
311 | name as a constant in the same package. This is probably a Good Thing. |
312 | ||
313 | A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT | |
314 | ENV INC SIG> is not allowed anywhere but in package C<main::>, for | |
315 | technical reasons. | |
316 | ||
317 | Even though a reference may be declared as a constant, the reference may | |
318 | point to data which may be changed, as this code shows. | |
319 | ||
320 | use constant CARRAY => [ 1,2,3,4 ]; | |
321 | print CARRAY->[1]; | |
322 | CARRAY->[1] = " be changed"; | |
323 | print CARRAY->[1]; | |
54310121 | 324 | |
325 | Unlike constants in some languages, these cannot be overridden | |
326 | on the command line or via environment variables. | |
327 | ||
a3cb178b GS |
328 | You can get into trouble if you use constants in a context which |
329 | automatically quotes barewords (as is true for any subroutine call). | |
330 | For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will | |
331 | be interpreted as a string. Use C<$hash{CONSTANT()}> or | |
332 | C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from | |
333 | kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword | |
83763826 GS |
334 | immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'> |
335 | (or simply use a comma in place of the big arrow) instead of | |
336 | C<CONSTANT =E<gt> 'value'>. | |
a3cb178b | 337 | |
54310121 | 338 | =head1 AUTHOR |
339 | ||
83763826 | 340 | Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from |
54310121 | 341 | many other folks. |
342 | ||
e1e60e72 CW |
343 | Multiple constant declarations at once added by Casey West, |
344 | E<lt>F<casey@geeknest.com>E<gt>. | |
3cb88d13 | 345 | |
b0d6893f IK |
346 | Assorted documentation fixes by Ilmari Karonen, |
347 | E<lt>F<perl@itz.pp.sci.fi>E<gt>. | |
348 | ||
54310121 | 349 | =head1 COPYRIGHT |
350 | ||
83763826 | 351 | Copyright (C) 1997, 1999 Tom Phoenix |
54310121 | 352 | |
353 | This module is free software; you can redistribute it or modify it | |
354 | under the same terms as Perl itself. | |
355 | ||
356 | =cut |