lib/constant.pm

   1 package constant;
   2
   3 use strict;
   4 use 5.006_00;
   5 use warnings::register;
   6
   7 our($VERSION, %declared);
   8 $VERSION = '1.04';
   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                 } 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");
  88             } else {
  89                 Carp::croak("Constant name looks like boolean value");
  90             }
  91
  92         } else {
  93            # Must have bad characters
  94             require Carp;
  95             Carp::croak("Constant name '$name' has invalid characters");
  96         }
  97
  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             }
 116         }
 117     }
 118 }
 119
 120 1;
 121
 122 __END__
 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
 142     # references can be constants
 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");
 152     print CHASH->[10];                  # compile-time error
 153
 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',
 161         USERNAME        => scalar getpwuid($<),      # this works
 162         USERINFO        => getpwuid($<),             # THIS IS A BUG!
 163     };
 164
 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
 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.
 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
 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.
 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)
 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
 222
 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.
 225
 226     use constant UNICORNS => ();
 227
 228     print "Impossible!\n"  if defined UNICORNS;
 229     my @unicorns = UNICORNS;  # there are no unicorns
 230
 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.)
 245
 246     use constant E2BIG => ($! = 7);
 247     print   E2BIG, "\n";        # something like "Arg list too long"
 248     print 0+E2BIG, "\n";        # "7"
 249
 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
 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
 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.
 280
 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     }
 295
 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
 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];
 324
 325 Unlike constants in some languages, these cannot be overridden
 326 on the command line or via environment variables.
 327
 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
 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'>.
 337
 338 =head1 AUTHOR
 339
 340 Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
 341 many other folks.
 342
 343 Multiple constant declarations at once added by Casey West,
 344 E<lt>F<casey@geeknest.com>E<gt>.
 345
 346 Assorted documentation fixes by Ilmari Karonen,
 347 E<lt>F<perl@itz.pp.sci.fi>E<gt>.
 348
 349 =head1 COPYRIGHT
 350
 351 Copyright (C) 1997, 1999 Tom Phoenix
 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