Commit | Line | Data |
---|---|---|
54310121 | 1 | package constant; |
2 | ||
83763826 | 3 | use strict; |
17f410f9 | 4 | use 5.005_64; |
d3a7d8c7 | 5 | use warnings::register; |
17f410f9 GS |
6 | |
7 | our($VERSION, %declared); | |
d3a7d8c7 | 8 | $VERSION = '1.02'; |
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;' | |
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 | |
5bc457ce | 39 | if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) { |
83763826 GS |
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 | |
d3a7d8c7 | 55 | if (warnings::enabled()) { |
83763826 | 56 | if ($keywords{$name}) { |
d3a7d8c7 | 57 | warnings::warn("Constant name '$name' is a Perl keyword"); |
83763826 | 58 | } elsif ($forced_into_main{$name}) { |
d3a7d8c7 | 59 | warnings::warn("Constant name '$name' is " . |
83763826 | 60 | "forced into package main::"); |
83763826 GS |
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! | |
d3a7d8c7 | 65 | warnings::warn("Constant name '$name' has unknown problems"); |
83763826 GS |
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__ | |
54310121 | 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 | ||
83763826 | 124 | # references can be constants |
779c5bc9 GS |
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"); | |
83763826 | 134 | print CHASH->[10]; # compile-time error |
779c5bc9 | 135 | |
54310121 | 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 | |
83763826 GS |
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. | |
54310121 | 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. | |
7e5dee47 | 199 | (These error numbers aren't totally portable, alas.) |
54310121 | 200 | |
201 | use constant E2BIG => ($! = 7); | |
202 | print E2BIG, "\n"; # something like "Arg list too long" | |
203 | print 0+E2BIG, "\n"; # "7" | |
204 | ||
83763826 GS |
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 | } | |
779c5bc9 | 223 | |
54310121 | 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 | |
83763826 GS |
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]; | |
54310121 | 252 | |
253 | Unlike constants in some languages, these cannot be overridden | |
254 | on the command line or via environment variables. | |
255 | ||
a3cb178b GS |
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 | |
83763826 GS |
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'>. | |
a3cb178b | 265 | |
54310121 | 266 | =head1 AUTHOR |
267 | ||
83763826 | 268 | Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from |
54310121 | 269 | many other folks. |
270 | ||
271 | =head1 COPYRIGHT | |
272 | ||
83763826 | 273 | Copyright (C) 1997, 1999 Tom Phoenix |
54310121 | 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 |