1 | package constant;
|
---|
2 |
|
---|
3 | use strict;
|
---|
4 | use 5.006_00;
|
---|
5 | use warnings::register;
|
---|
6 |
|
---|
7 | our($VERSION, %declared);
|
---|
8 | $VERSION = '1.05';
|
---|
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 %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;
|
---|
42 | }
|
---|
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 | }
|
---|
75 | }
|
---|
76 |
|
---|
77 | # Looks like a boolean
|
---|
78 | # use constant FRED == fred;
|
---|
79 | } elsif ($name =~ /^[01]?\z/) {
|
---|
80 | require Carp;
|
---|
81 | if (@_) {
|
---|
82 | Carp::croak("Constant name '$name' is invalid");
|
---|
83 | } else {
|
---|
84 | Carp::croak("Constant name looks like boolean value");
|
---|
85 | }
|
---|
86 |
|
---|
87 | } else {
|
---|
88 | # Must have bad characters
|
---|
89 | require Carp;
|
---|
90 | Carp::croak("Constant name '$name' has invalid characters");
|
---|
91 | }
|
---|
92 |
|
---|
93 | {
|
---|
94 | no strict 'refs';
|
---|
95 | my $full_name = "${pkg}::$name";
|
---|
96 | $declared{$full_name}++;
|
---|
97 | if ($multiple) {
|
---|
98 | my $scalar = $constants{$name};
|
---|
99 | *$full_name = sub () { $scalar };
|
---|
100 | } else {
|
---|
101 | if (@_ == 1) {
|
---|
102 | my $scalar = $_[0];
|
---|
103 | *$full_name = sub () { $scalar };
|
---|
104 | } elsif (@_) {
|
---|
105 | my @list = @_;
|
---|
106 | *$full_name = sub () { @list };
|
---|
107 | } else {
|
---|
108 | *$full_name = sub () { };
|
---|
109 | }
|
---|
110 | }
|
---|
111 | }
|
---|
112 | }
|
---|
113 | }
|
---|
114 |
|
---|
115 | 1;
|
---|
116 |
|
---|
117 | __END__
|
---|
118 |
|
---|
119 | =head1 NAME
|
---|
120 |
|
---|
121 | constant - Perl pragma to declare constants
|
---|
122 |
|
---|
123 | =head1 SYNOPSIS
|
---|
124 |
|
---|
125 | use constant PI => 4 * atan2(1, 1);
|
---|
126 | use constant DEBUG => 0;
|
---|
127 |
|
---|
128 | print "Pi equals ", PI, "...\n" if DEBUG;
|
---|
129 |
|
---|
130 | use constant {
|
---|
131 | SEC => 0,
|
---|
132 | MIN => 1,
|
---|
133 | HOUR => 2,
|
---|
134 | MDAY => 3,
|
---|
135 | MON => 4,
|
---|
136 | YEAR => 5,
|
---|
137 | WDAY => 6,
|
---|
138 | YDAY => 7,
|
---|
139 | ISDST => 8,
|
---|
140 | };
|
---|
141 |
|
---|
142 | use constant WEEKDAYS => qw(
|
---|
143 | Sunday Monday Tuesday Wednesday Thursday Friday Saturday
|
---|
144 | );
|
---|
145 |
|
---|
146 | print "Today is ", (WEEKDAYS)[ (localtime)[WDAY] ], ".\n";
|
---|
147 |
|
---|
148 | =head1 DESCRIPTION
|
---|
149 |
|
---|
150 | This will declare a symbol to be a constant with the given value.
|
---|
151 |
|
---|
152 | When you declare a constant such as C<PI> using the method shown
|
---|
153 | above, each machine your script runs upon can have as many digits
|
---|
154 | of accuracy as it can use. Also, your program will be easier to
|
---|
155 | read, more likely to be maintained (and maintained correctly), and
|
---|
156 | far less likely to send a space probe to the wrong planet because
|
---|
157 | nobody noticed the one equation in which you wrote C<3.14195>.
|
---|
158 |
|
---|
159 | When a constant is used in an expression, perl replaces it with its
|
---|
160 | value at compile time, and may then optimize the expression further.
|
---|
161 | In particular, any code in an C<if (CONSTANT)> block will be optimized
|
---|
162 | away if the constant is false.
|
---|
163 |
|
---|
164 | =head1 NOTES
|
---|
165 |
|
---|
166 | As with all C<use> directives, defining a constant happens at
|
---|
167 | compile time. Thus, it's probably not correct to put a constant
|
---|
168 | declaration inside of a conditional statement (like C<if ($foo)
|
---|
169 | { use constant ... }>).
|
---|
170 |
|
---|
171 | Constants defined using this module cannot be interpolated into
|
---|
172 | strings like variables. However, concatenation works just fine:
|
---|
173 |
|
---|
174 | print "Pi equals PI...\n"; # WRONG: does not expand "PI"
|
---|
175 | print "Pi equals ".PI."...\n"; # right
|
---|
176 |
|
---|
177 | Even though a reference may be declared as a constant, the reference may
|
---|
178 | point to data which may be changed, as this code shows.
|
---|
179 |
|
---|
180 | use constant ARRAY => [ 1,2,3,4 ];
|
---|
181 | print ARRAY->[1];
|
---|
182 | ARRAY->[1] = " be changed";
|
---|
183 | print ARRAY->[1];
|
---|
184 |
|
---|
185 | Dereferencing constant references incorrectly (such as using an array
|
---|
186 | subscript on a constant hash reference, or vice versa) will be trapped at
|
---|
187 | compile time.
|
---|
188 |
|
---|
189 | Constants belong to the package they are defined in. To refer to a
|
---|
190 | constant defined in another package, specify the full package name, as
|
---|
191 | in C<Some::Package::CONSTANT>. Constants may be exported by modules,
|
---|
192 | and may also be called as either class or instance methods, that is,
|
---|
193 | as C<< Some::Package->CONSTANT >> or as C<< $obj->CONSTANT >> where
|
---|
194 | C<$obj> is an instance of C<Some::Package>. Subclasses may define
|
---|
195 | their own constants to override those in their base class.
|
---|
196 |
|
---|
197 | The use of all caps for constant names is merely a convention,
|
---|
198 | although it is recommended in order to make constants stand out
|
---|
199 | and to help avoid collisions with other barewords, keywords, and
|
---|
200 | subroutine names. Constant names must begin with a letter or
|
---|
201 | underscore. Names beginning with a double underscore are reserved. Some
|
---|
202 | poor choices for names will generate warnings, if warnings are enabled at
|
---|
203 | compile time.
|
---|
204 |
|
---|
205 | =head2 List constants
|
---|
206 |
|
---|
207 | Constants may be lists of more (or less) than one value. A constant
|
---|
208 | with no values evaluates to C<undef> in scalar context. Note that
|
---|
209 | constants with more than one value do I<not> return their last value in
|
---|
210 | scalar context as one might expect. They currently return the number
|
---|
211 | of values, but B<this may change in the future>. Do not use constants
|
---|
212 | with multiple values in scalar context.
|
---|
213 |
|
---|
214 | B<NOTE:> This implies that the expression defining the value of a
|
---|
215 | constant is evaluated in list context. This may produce surprises:
|
---|
216 |
|
---|
217 | use constant TIMESTAMP => localtime; # WRONG!
|
---|
218 | use constant TIMESTAMP => scalar localtime; # right
|
---|
219 |
|
---|
220 | The first line above defines C<TIMESTAMP> as a 9-element list, as
|
---|
221 | returned by localtime() in list context. To set it to the string
|
---|
222 | returned by localtime() in scalar context, an explicit C<scalar>
|
---|
223 | keyword is required.
|
---|
224 |
|
---|
225 | List constants are lists, not arrays. To index or slice them, they
|
---|
226 | must be placed in parentheses.
|
---|
227 |
|
---|
228 | my @workdays = WEEKDAYS[1 .. 5]; # WRONG!
|
---|
229 | my @workdays = (WEEKDAYS)[1 .. 5]; # right
|
---|
230 |
|
---|
231 | =head2 Defining multiple constants at once
|
---|
232 |
|
---|
233 | Instead of writing multiple C<use constant> statements, you may define
|
---|
234 | multiple constants in a single statement by giving, instead of the
|
---|
235 | constant name, a reference to a hash where the keys are the names of
|
---|
236 | the constants to be defined. Obviously, all constants defined using
|
---|
237 | this method must have a single value.
|
---|
238 |
|
---|
239 | use constant {
|
---|
240 | FOO => "A single value",
|
---|
241 | BAR => "This", "won't", "work!", # Error!
|
---|
242 | };
|
---|
243 |
|
---|
244 | This is a fundamental limitation of the way hashes are constructed in
|
---|
245 | Perl. The error messages produced when this happens will often be
|
---|
246 | quite cryptic -- in the worst case there may be none at all, and
|
---|
247 | you'll only later find that something is broken.
|
---|
248 |
|
---|
249 | When defining multiple constants, you cannot use the values of other
|
---|
250 | constants defined in the same declaration. This is because the
|
---|
251 | calling package doesn't know about any constant within that group
|
---|
252 | until I<after> the C<use> statement is finished.
|
---|
253 |
|
---|
254 | use constant {
|
---|
255 | BITMASK => 0xAFBAEBA8,
|
---|
256 | NEGMASK => ~BITMASK, # Error!
|
---|
257 | };
|
---|
258 |
|
---|
259 | =head2 Magic constants
|
---|
260 |
|
---|
261 | Magical values and references can be made into constants at compile
|
---|
262 | time, allowing for way cool stuff like this. (These error numbers
|
---|
263 | aren't totally portable, alas.)
|
---|
264 |
|
---|
265 | use constant E2BIG => ($! = 7);
|
---|
266 | print E2BIG, "\n"; # something like "Arg list too long"
|
---|
267 | print 0+E2BIG, "\n"; # "7"
|
---|
268 |
|
---|
269 | You can't produce a tied constant by giving a tied scalar as the
|
---|
270 | value. References to tied variables, however, can be used as
|
---|
271 | constants without any problems.
|
---|
272 |
|
---|
273 | =head1 TECHNICAL NOTES
|
---|
274 |
|
---|
275 | In the current implementation, scalar constants are actually
|
---|
276 | inlinable subroutines. As of version 5.004 of Perl, the appropriate
|
---|
277 | scalar constant is inserted directly in place of some subroutine
|
---|
278 | calls, thereby saving the overhead of a subroutine call. See
|
---|
279 | L<perlsub/"Constant Functions"> for details about how and when this
|
---|
280 | happens.
|
---|
281 |
|
---|
282 | In the rare case in which you need to discover at run time whether a
|
---|
283 | particular constant has been declared via this module, you may use
|
---|
284 | this function to examine the hash C<%constant::declared>. If the given
|
---|
285 | constant name does not include a package name, the current package is
|
---|
286 | used.
|
---|
287 |
|
---|
288 | sub declared ($) {
|
---|
289 | use constant 1.01; # don't omit this!
|
---|
290 | my $name = shift;
|
---|
291 | $name =~ s/^::/main::/;
|
---|
292 | my $pkg = caller;
|
---|
293 | my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
|
---|
294 | $constant::declared{$full_name};
|
---|
295 | }
|
---|
296 |
|
---|
297 | =head1 BUGS
|
---|
298 |
|
---|
299 | In the current version of Perl, list constants are not inlined
|
---|
300 | and some symbols may be redefined without generating a warning.
|
---|
301 |
|
---|
302 | It is not possible to have a subroutine or a keyword with the same
|
---|
303 | name as a constant in the same package. This is probably a Good Thing.
|
---|
304 |
|
---|
305 | A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
|
---|
306 | ENV INC SIG> is not allowed anywhere but in package C<main::>, for
|
---|
307 | technical reasons.
|
---|
308 |
|
---|
309 | Unlike constants in some languages, these cannot be overridden
|
---|
310 | on the command line or via environment variables.
|
---|
311 |
|
---|
312 | You can get into trouble if you use constants in a context which
|
---|
313 | automatically quotes barewords (as is true for any subroutine call).
|
---|
314 | For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
|
---|
315 | be interpreted as a string. Use C<$hash{CONSTANT()}> or
|
---|
316 | C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
|
---|
317 | kicking in. Similarly, since the C<< => >> operator quotes a bareword
|
---|
318 | immediately to its left, you have to say C<< CONSTANT() => 'value' >>
|
---|
319 | (or simply use a comma in place of the big arrow) instead of
|
---|
320 | C<< CONSTANT => 'value' >>.
|
---|
321 |
|
---|
322 | =head1 AUTHOR
|
---|
323 |
|
---|
324 | Tom Phoenix, E<lt>F<[email protected]>E<gt>, with help from
|
---|
325 | many other folks.
|
---|
326 |
|
---|
327 | Multiple constant declarations at once added by Casey West,
|
---|
328 | E<lt>F<[email protected]>E<gt>.
|
---|
329 |
|
---|
330 | Documentation mostly rewritten by Ilmari Karonen,
|
---|
331 | E<lt>F<[email protected]>E<gt>.
|
---|
332 |
|
---|
333 | =head1 COPYRIGHT
|
---|
334 |
|
---|
335 | Copyright (C) 1997, 1999 Tom Phoenix
|
---|
336 |
|
---|
337 | This module is free software; you can redistribute it or modify it
|
---|
338 | under the same terms as Perl itself.
|
---|
339 |
|
---|
340 | =cut
|
---|