1 | package constant; |
---|
2 | |
---|
3 | use strict; |
---|
4 | use 5.005_64; |
---|
5 | use warnings::register; |
---|
6 | |
---|
7 | our($VERSION, %declared); |
---|
8 | $VERSION = '1.02'; |
---|
9 | |
---|
10 | #======================================================================= |
---|
11 | |
---|
12 | # Some names are evil choices. |
---|
13 | my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD }; |
---|
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;' |
---|
31 | my $name = shift; |
---|
32 | unless (defined $name) { |
---|
33 | require Carp; |
---|
34 | Carp::croak("Can't use undef as constant name"); |
---|
35 | } |
---|
36 | my $pkg = caller; |
---|
37 | |
---|
38 | # Normal constant name |
---|
39 | if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { |
---|
40 | # Everything is okay |
---|
41 | |
---|
42 | # Name forced into main, but we're not in main. Fatal. |
---|
43 | } elsif ($forced_into_main{$name} and $pkg ne 'main') { |
---|
44 | require Carp; |
---|
45 | Carp::croak("Constant name '$name' is forced into main::"); |
---|
46 | |
---|
47 | # Starts with double underscore. Fatal. |
---|
48 | } elsif ($name =~ /^__/) { |
---|
49 | require Carp; |
---|
50 | Carp::croak("Constant name '$name' begins with '__'"); |
---|
51 | |
---|
52 | # Maybe the name is tolerable |
---|
53 | } elsif ($name =~ /^[A-Za-z_]\w*\z/) { |
---|
54 | # Then we'll warn only if you've asked for warnings |
---|
55 | if (warnings::enabled()) { |
---|
56 | if ($keywords{$name}) { |
---|
57 | warnings::warn("Constant name '$name' is a Perl keyword"); |
---|
58 | } elsif ($forced_into_main{$name}) { |
---|
59 | warnings::warn("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 | warnings::warn("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 |
---|