lib/constant.pm

   1 package constant;
   2
   3 use strict;
   4 use 5.005_64;
   5
   6 our($VERSION, %declared);
   7 $VERSION = '1.01';
   8
   9 #=======================================================================
  10
  11 # Some names are evil choices.
  12 my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
  13
  14 my %forced_into_main = map +($_, 1),
  15     qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
  16
  17 my %forbidden = (%keywords, %forced_into_main);
  18
  19 #=======================================================================
  20 # import() - import symbols into user's namespace
  21 #
  22 # What we actually do is define a function in the caller's namespace
  23 # which returns the value. The function we create will normally
  24 # be inlined as a constant, thereby avoiding further sub calling
  25 # overhead.
  26 #=======================================================================
  27 sub import {
  28     my $class = shift;
  29     return unless @_;                   # Ignore 'use constant;'
  30     my $name = shift;
  31     unless (defined $name) {
  32         require Carp;
  33         Carp::croak("Can't use undef as constant name");
  34     }
  35     my $pkg = caller;
  36
  37     # Normal constant name
  38     if ($name =~ /^(?:[A-Z]\w|_[A-Z])\w*\z/ and !$forbidden{$name}) {
  39         # Everything is okay
  40
  41     # Name forced into main, but we're not in main. Fatal.
  42     } elsif ($forced_into_main{$name} and $pkg ne 'main') {
  43         require Carp;
  44         Carp::croak("Constant name '$name' is forced into main::");
  45
  46     # Starts with double underscore. Fatal.
  47     } elsif ($name =~ /^__/) {
  48         require Carp;
  49         Carp::croak("Constant name '$name' begins with '__'");
  50
  51     # Maybe the name is tolerable
  52     } elsif ($name =~ /^[A-Za-z_]\w*\z/) {
  53         # Then we'll warn only if you've asked for warnings
  54         if ($^W) {
  55             require Carp;
  56             if ($keywords{$name}) {
  57                 Carp::carp("Constant name '$name' is a Perl keyword");
  58             } elsif ($forced_into_main{$name}) {
  59                 Carp::carp("Constant name '$name' is " .
  60                     "forced into package main::");
  61             } elsif (1 == length $name) {
  62                 Carp::carp("Constant name '$name' is too short");
  63             } elsif ($name =~ /^_?[a-z\d]/) {
  64                 Carp::carp("Constant name '$name' should " .
  65                     "have an initial capital letter");
  66             } else {
  67                 # Catch-all - what did I miss? If you get this error,
  68                 # please let me know what your constant's name was.
  69                 # Write to <rootbeer@redcat.com>. Thanks!
  70                 Carp::carp("Constant name '$name' has unknown problems");
  71             }
  72         }
  73
  74     # Looks like a boolean
  75     #           use constant FRED == fred;
  76     } elsif ($name =~ /^[01]?\z/) {
  77         require Carp;
  78         if (@_) {
  79             Carp::croak("Constant name '$name' is invalid");
  80         } else {
  81             Carp::croak("Constant name looks like boolean value");
  82         }
  83
  84     } else {
  85         # Must have bad characters
  86         require Carp;
  87         Carp::croak("Constant name '$name' has invalid characters");
  88     }
  89
  90     {
  91         no strict 'refs';
  92         my $full_name = "${pkg}::$name";
  93         $declared{$full_name}++;
  94         if (@_ == 1) {
  95             my $scalar = $_[0];
  96             *$full_name = sub () { $scalar };
  97         } elsif (@_) {
  98             my @list = @_;
  99             *$full_name = sub () { @list };
 100         } else {
 101             *$full_name = sub () { };
 102         }
 103     }
 104
 105 }
 106
 107 1;
 108
 109 __END__
 110
 111 =head1 NAME
 112
 113 constant - Perl pragma to declare constants
 114
 115 =head1 SYNOPSIS
 116
 117     use constant BUFFER_SIZE    => 4096;
 118     use constant ONE_YEAR       => 365.2425 * 24 * 60 * 60;
 119     use constant PI             => 4 * atan2 1, 1;
 120     use constant DEBUGGING      => 0;
 121     use constant ORACLE         => 'oracle@cs.indiana.edu';
 122     use constant USERNAME       => scalar getpwuid($<);
 123     use constant USERINFO       => getpwuid($<);
 124
 125     sub deg2rad { PI * $_[0] / 180 }
 126
 127     print "This line does nothing"              unless DEBUGGING;
 128
 129     # references can be constants
 130     use constant CHASH          => { foo => 42 };
 131     use constant CARRAY         => [ 1,2,3,4 ];
 132     use constant CPSEUDOHASH    => [ { foo => 1}, 42 ];
 133     use constant CCODE          => sub { "bite $_[0]\n" };
 134
 135     print CHASH->{foo};
 136     print CARRAY->[$i];
 137     print CPSEUDOHASH->{foo};
 138     print CCODE->("me");
 139     print CHASH->[10];                  # compile-time error
 140
 141 =head1 DESCRIPTION
 142
 143 This will declare a symbol to be a constant with the given scalar
 144 or list value.
 145
 146 When you declare a constant such as C<PI> using the method shown
 147 above, each machine your script runs upon can have as many digits
 148 of accuracy as it can use. Also, your program will be easier to
 149 read, more likely to be maintained (and maintained correctly), and
 150 far less likely to send a space probe to the wrong planet because
 151 nobody noticed the one equation in which you wrote C<3.14195>.
 152
 153 =head1 NOTES
 154
 155 The value or values are evaluated in a list context. You may override
 156 this with C<scalar> as shown above.
 157
 158 These constants do not directly interpolate into double-quotish
 159 strings, although you may do so indirectly. (See L<perlref> for
 160 details about how this works.)
 161
 162     print "The value of PI is @{[ PI ]}.\n";
 163
 164 List constants are returned as lists, not as arrays.
 165
 166     $homedir = USERINFO[7];             # WRONG
 167     $homedir = (USERINFO)[7];           # Right
 168
 169 The use of all caps for constant names is merely a convention,
 170 although it is recommended in order to make constants stand out
 171 and to help avoid collisions with other barewords, keywords, and
 172 subroutine names. Constant names must begin with a letter or
 173 underscore. Names beginning with a double underscore are reserved. Some
 174 poor choices for names will generate warnings, if warnings are enabled at
 175 compile time.
 176
 177 Constant symbols are package scoped (rather than block scoped, as
 178 C<use strict> is). That is, you can refer to a constant from package
 179 Other as C<Other::CONST>.
 180
 181 As with all C<use> directives, defining a constant happens at
 182 compile time. Thus, it's probably not correct to put a constant
 183 declaration inside of a conditional statement (like C<if ($foo)
 184 { use constant ... }>).
 185
 186 Omitting the value for a symbol gives it the value of C<undef> in
 187 a scalar context or the empty list, C<()>, in a list context. This
 188 isn't so nice as it may sound, though, because in this case you
 189 must either quote the symbol name, or use a big arrow, (C<=E<gt>>),
 190 with nothing to point to. It is probably best to declare these
 191 explicitly.
 192
 193     use constant UNICORNS       => ();
 194     use constant LOGFILE        => undef;
 195
 196 The result from evaluating a list constant in a scalar context is
 197 not documented, and is B<not> guaranteed to be any particular value
 198 in the future. In particular, you should not rely upon it being
 199 the number of elements in the list, especially since it is not
 200 B<necessarily> that value in the current implementation.
 201
 202 Magical values, tied values, and references can be made into
 203 constants at compile time, allowing for way cool stuff like this.
 204 (These error numbers aren't totally portable, alas.)
 205
 206     use constant E2BIG => ($! = 7);
 207     print   E2BIG, "\n";        # something like "Arg list too long"
 208     print 0+E2BIG, "\n";        # "7"
 209
 210 Dereferencing constant references incorrectly (such as using an array
 211 subscript on a constant hash reference, or vice versa) will be trapped at
 212 compile time.
 213
 214 In the rare case in which you need to discover at run time whether a
 215 particular constant has been declared via this module, you may use
 216 this function to examine the hash C<%constant::declared>. If the given
 217 constant name does not include a package name, the current package is
 218 used.
 219
 220     sub declared ($) {
 221         use constant 1.01;              # don't omit this!
 222         my $name = shift;
 223         $name =~ s/^::/main::/;
 224         my $pkg = caller;
 225         my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
 226         $constant::declared{$full_name};
 227     }
 228
 229 =head1 TECHNICAL NOTE
 230
 231 In the current implementation, scalar constants are actually
 232 inlinable subroutines. As of version 5.004 of Perl, the appropriate
 233 scalar constant is inserted directly in place of some subroutine
 234 calls, thereby saving the overhead of a subroutine call. See
 235 L<perlsub/"Constant Functions"> for details about how and when this
 236 happens.
 237
 238 =head1 BUGS
 239
 240 In the current version of Perl, list constants are not inlined
 241 and some symbols may be redefined without generating a warning.
 242
 243 It is not possible to have a subroutine or keyword with the same
 244 name as a constant in the same package. This is probably a Good Thing.
 245
 246 A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
 247 ENV INC SIG> is not allowed anywhere but in package C<main::>, for
 248 technical reasons.
 249
 250 Even though a reference may be declared as a constant, the reference may
 251 point to data which may be changed, as this code shows.
 252
 253     use constant CARRAY         => [ 1,2,3,4 ];
 254     print CARRAY->[1];
 255     CARRAY->[1] = " be changed";
 256     print CARRAY->[1];
 257
 258 Unlike constants in some languages, these cannot be overridden
 259 on the command line or via environment variables.
 260
 261 You can get into trouble if you use constants in a context which
 262 automatically quotes barewords (as is true for any subroutine call).
 263 For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
 264 be interpreted as a string.  Use C<$hash{CONSTANT()}> or
 265 C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
 266 kicking in.  Similarly, since the C<=E<gt>> operator quotes a bareword
 267 immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'>
 268 (or simply use a comma in place of the big arrow) instead of
 269 C<CONSTANT =E<gt> 'value'>.
 270
 271 =head1 AUTHOR
 272
 273 Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
 274 many other folks.
 275
 276 =head1 COPYRIGHT
 277
 278 Copyright (C) 1997, 1999 Tom Phoenix
 279
 280 This module is free software; you can redistribute it or modify it
 281 under the same terms as Perl itself.
 282
 283 =cut