Commit | Line | Data |
54310121 |
1 | package constant; |
2 | |
83763826 |
3 | use strict; |
b0d6893f |
4 | use 5.006_00; |
d3a7d8c7 |
5 | use warnings::register; |
17f410f9 |
6 | |
7 | our($VERSION, %declared); |
b0d6893f |
8 | $VERSION = '1.04'; |
83763826 |
9 | |
10 | #======================================================================= |
11 | |
83763826 |
12 | # Some names are evil choices. |
7d30b5c4 |
13 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
83763826 |
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 |
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 |
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 |
93 | # Must have bad characters |
94 | require Carp; |
95 | Carp::croak("Constant name '$name' has invalid characters"); |
83763826 |
96 | } |
97 | |
3cb88d13 |
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 |
116 | } |
117 | } |
83763826 |
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 |
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 |
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 |
161 | USERNAME => scalar getpwuid($<), # this works |
162 | USERINFO => getpwuid($<), # THIS IS A BUG! |
3cb88d13 |
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 |
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 |
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 |
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 |
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 |
228 | print "Impossible!\n" if defined UNICORNS; |
229 | my @unicorns = UNICORNS; # there are no unicorns |
54310121 |
230 | |
b0d6893f |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
343 | Multiple constant declarations at once added by Casey West, |
344 | E<lt>F<casey@geeknest.com>E<gt>. |
3cb88d13 |
345 | |
b0d6893f |
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 |