lib/constant.pm

   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 %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($<),
 162         USERINFO        => getpwuid($<),
 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>.
 204
 205 As with all C<use> directives, defining a constant happens at
 206 compile time. Thus, it's probably not correct to put a constant
 207 declaration inside of a conditional statement (like C<if ($foo)
 208 { use constant ... }>).  When defining multiple constants, you
 209 cannot use the values of other constants within the same declaration
 210 scope.  This is because the calling package doesn't know about any
 211 constant within that group until I<after> the C<use> statement is
 212 finished.
 213
 214     use constant {
 215         AGE    => 20,
 216         PERSON => { age => AGE }, # Error!
 217     };
 218     [...]
 219     use constant PERSON => { age => AGE }; # Right
 220
 221 Omitting the value for a symbol gives it the value of C<undef> in
 222 a scalar context or the empty list, C<()>, in a list context. This
 223 isn't so nice as it may sound, though, because in this case you
 224 must either quote the symbol name, or use a big arrow, (C<=E<gt>>),
 225 with nothing to point to. It is also illegal to do when defining
 226 multiple constants at once, you must declare them explicitly.  It
 227 is probably best to declare these explicitly.
 228
 229     use constant UNICORNS       => ();
 230     use constant LOGFILE        => undef;
 231
 232 The result from evaluating a list constant in a scalar context is
 233 not documented, and is B<not> guaranteed to be any particular value
 234 in the future. In particular, you should not rely upon it being
 235 the number of elements in the list, especially since it is not
 236 B<necessarily> that value in the current implementation.
 237
 238 Magical values, tied values, and references can be made into
 239 constants at compile time, allowing for way cool stuff like this.
 240 (These error numbers aren't totally portable, alas.)
 241
 242     use constant E2BIG => ($! = 7);
 243     print   E2BIG, "\n";        # something like "Arg list too long"
 244     print 0+E2BIG, "\n";        # "7"
 245
 246 Dereferencing constant references incorrectly (such as using an array
 247 subscript on a constant hash reference, or vice versa) will be trapped at
 248 compile time.
 249
 250 When declaring multiple constants, all constant values will be a scalar.
 251 This is because C<constant> can't guess the intent of the programmer
 252 correctly all the time since values must be expressed in scalar context
 253 within a hash ref.
 254
 255 In the rare case in which you need to discover at run time whether a
 256 particular constant has been declared via this module, you may use
 257 this function to examine the hash C<%constant::declared>. If the given
 258 constant name does not include a package name, the current package is
 259 used.
 260
 261     sub declared ($) {
 262         use constant 1.01;              # don't omit this!
 263         my $name = shift;
 264         $name =~ s/^::/main::/;
 265         my $pkg = caller;
 266         my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
 267         $constant::declared{$full_name};
 268     }
 269
 270 =head1 TECHNICAL NOTE
 271
 272 In the current implementation, scalar constants are actually
 273 inlinable subroutines. As of version 5.004 of Perl, the appropriate
 274 scalar constant is inserted directly in place of some subroutine
 275 calls, thereby saving the overhead of a subroutine call. See
 276 L<perlsub/"Constant Functions"> for details about how and when this
 277 happens.
 278
 279 =head1 BUGS
 280
 281 In the current version of Perl, list constants are not inlined
 282 and some symbols may be redefined without generating a warning.
 283
 284 It is not possible to have a subroutine or keyword with the same
 285 name as a constant in the same package. This is probably a Good Thing.
 286
 287 A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
 288 ENV INC SIG> is not allowed anywhere but in package C<main::>, for
 289 technical reasons.
 290
 291 Even though a reference may be declared as a constant, the reference may
 292 point to data which may be changed, as this code shows.
 293
 294     use constant CARRAY         => [ 1,2,3,4 ];
 295     print CARRAY->[1];
 296     CARRAY->[1] = " be changed";
 297     print CARRAY->[1];
 298
 299 Unlike constants in some languages, these cannot be overridden
 300 on the command line or via environment variables.
 301
 302 You can get into trouble if you use constants in a context which
 303 automatically quotes barewords (as is true for any subroutine call).
 304 For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
 305 be interpreted as a string.  Use C<$hash{CONSTANT()}> or
 306 C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
 307 kicking in.  Similarly, since the C<=E<gt>> operator quotes a bareword
 308 immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'>
 309 (or simply use a comma in place of the big arrow) instead of
 310 C<CONSTANT =E<gt> 'value'>.
 311
 312 =head1 AUTHOR
 313
 314 Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
 315 many other folks.
 316
 317 Multiple constant declarations at once added by Casey West,
 318 E<lt>F<casey@geeknest.com>E<gt>.
 319
 320 =head1 COPYRIGHT
 321
 322 Copyright (C) 1997, 1999 Tom Phoenix
 323
 324 This module is free software; you can redistribute it or modify it
 325 under the same terms as Perl itself.
 326
 327 =cut