mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-23 06:27:55 +00:00
398 lines
13 KiB
Perl
398 lines
13 KiB
Perl
package constant;
|
|
use 5.005;
|
|
use strict;
|
|
use warnings::register;
|
|
|
|
use vars qw($VERSION %declared);
|
|
$VERSION = '1.21';
|
|
|
|
#=======================================================================
|
|
|
|
# Some names are evil choices.
|
|
my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
|
|
$keywords{UNITCHECK}++ if $] > 5.009;
|
|
|
|
my %forced_into_main = map +($_, 1),
|
|
qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
|
|
|
|
my %forbidden = (%keywords, %forced_into_main);
|
|
|
|
my $str_end = $] >= 5.006 ? "\\z" : "\\Z";
|
|
my $normal_constant_name = qr/^_?[^\W_0-9]\w*$str_end/;
|
|
my $tolerable = qr/^[A-Za-z_]\w*$str_end/;
|
|
my $boolean = qr/^[01]?$str_end/;
|
|
|
|
BEGIN {
|
|
# We'd like to do use constant _CAN_PCS => $] > 5.009002
|
|
# but that's a bit tricky before we load the constant module :-)
|
|
# By doing this, we save 1 run time check for *every* call to import.
|
|
no strict 'refs';
|
|
my $const = $] > 5.009002;
|
|
*_CAN_PCS = sub () {$const};
|
|
}
|
|
|
|
#=======================================================================
|
|
# import() - import symbols into user's namespace
|
|
#
|
|
# What we actually do is define a function in the caller's namespace
|
|
# which returns the value. The function we create will normally
|
|
# be inlined as a constant, thereby avoiding further sub calling
|
|
# overhead.
|
|
#=======================================================================
|
|
sub import {
|
|
my $class = shift;
|
|
return unless @_; # Ignore 'use constant;'
|
|
my $constants;
|
|
my $multiple = ref $_[0];
|
|
my $pkg = caller;
|
|
my $flush_mro;
|
|
my $symtab;
|
|
|
|
if (_CAN_PCS) {
|
|
no strict 'refs';
|
|
$symtab = \%{$pkg . '::'};
|
|
};
|
|
|
|
if ( $multiple ) {
|
|
if (ref $_[0] ne 'HASH') {
|
|
require Carp;
|
|
Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
|
|
}
|
|
$constants = shift;
|
|
} else {
|
|
unless (defined $_[0]) {
|
|
require Carp;
|
|
Carp::croak("Can't use undef as constant name");
|
|
}
|
|
$constants->{+shift} = undef;
|
|
}
|
|
|
|
foreach my $name ( keys %$constants ) {
|
|
# Normal constant name
|
|
if ($name =~ $normal_constant_name and !$forbidden{$name}) {
|
|
# Everything is okay
|
|
|
|
# Name forced into main, but we're not in main. Fatal.
|
|
} elsif ($forced_into_main{$name} and $pkg ne 'main') {
|
|
require Carp;
|
|
Carp::croak("Constant name '$name' is forced into main::");
|
|
|
|
# Starts with double underscore. Fatal.
|
|
} elsif ($name =~ /^__/) {
|
|
require Carp;
|
|
Carp::croak("Constant name '$name' begins with '__'");
|
|
|
|
# Maybe the name is tolerable
|
|
} elsif ($name =~ $tolerable) {
|
|
# Then we'll warn only if you've asked for warnings
|
|
if (warnings::enabled()) {
|
|
if ($keywords{$name}) {
|
|
warnings::warn("Constant name '$name' is a Perl keyword");
|
|
} elsif ($forced_into_main{$name}) {
|
|
warnings::warn("Constant name '$name' is " .
|
|
"forced into package main::");
|
|
}
|
|
}
|
|
|
|
# Looks like a boolean
|
|
# use constant FRED == fred;
|
|
} elsif ($name =~ $boolean) {
|
|
require Carp;
|
|
if (@_) {
|
|
Carp::croak("Constant name '$name' is invalid");
|
|
} else {
|
|
Carp::croak("Constant name looks like boolean value");
|
|
}
|
|
|
|
} else {
|
|
# Must have bad characters
|
|
require Carp;
|
|
Carp::croak("Constant name '$name' has invalid characters");
|
|
}
|
|
|
|
{
|
|
no strict 'refs';
|
|
my $full_name = "${pkg}::$name";
|
|
$declared{$full_name}++;
|
|
if ($multiple || @_ == 1) {
|
|
my $scalar = $multiple ? $constants->{$name} : $_[0];
|
|
|
|
# Work around perl bug #xxxxx: Sub names (actually glob
|
|
# names in general) ignore the UTF8 flag. So we have to
|
|
# turn it off to get the "right" symbol table entry.
|
|
utf8::is_utf8 $name and utf8::encode $name;
|
|
|
|
# The constant serves to optimise this entire block out on
|
|
# 5.8 and earlier.
|
|
if (_CAN_PCS && $symtab && !exists $symtab->{$name}) {
|
|
# No typeglob yet, so we can use a reference as space-
|
|
# efficient proxy for a constant subroutine
|
|
# The check in Perl_ck_rvconst knows that inlinable
|
|
# constants from cv_const_sv are read only. So we have to:
|
|
Internals::SvREADONLY($scalar, 1);
|
|
$symtab->{$name} = \$scalar;
|
|
++$flush_mro;
|
|
} else {
|
|
*$full_name = sub () { $scalar };
|
|
}
|
|
} elsif (@_) {
|
|
my @list = @_;
|
|
*$full_name = sub () { @list };
|
|
} else {
|
|
*$full_name = sub () { };
|
|
}
|
|
}
|
|
}
|
|
# Flush the cache exactly once if we make any direct symbol table changes.
|
|
mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
constant - Perl pragma to declare constants
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use constant PI => 4 * atan2(1, 1);
|
|
use constant DEBUG => 0;
|
|
|
|
print "Pi equals ", PI, "...\n" if DEBUG;
|
|
|
|
use constant {
|
|
SEC => 0,
|
|
MIN => 1,
|
|
HOUR => 2,
|
|
MDAY => 3,
|
|
MON => 4,
|
|
YEAR => 5,
|
|
WDAY => 6,
|
|
YDAY => 7,
|
|
ISDST => 8,
|
|
};
|
|
|
|
use constant WEEKDAYS => qw(
|
|
Sunday Monday Tuesday Wednesday Thursday Friday Saturday
|
|
);
|
|
|
|
print "Today is ", (WEEKDAYS)[ (localtime)[WDAY] ], ".\n";
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This pragma allows you to declare constants at compile-time.
|
|
|
|
When you declare a constant such as C<PI> using the method shown
|
|
above, each machine your script runs upon can have as many digits
|
|
of accuracy as it can use. Also, your program will be easier to
|
|
read, more likely to be maintained (and maintained correctly), and
|
|
far less likely to send a space probe to the wrong planet because
|
|
nobody noticed the one equation in which you wrote C<3.14195>.
|
|
|
|
When a constant is used in an expression, Perl replaces it with its
|
|
value at compile time, and may then optimize the expression further.
|
|
In particular, any code in an C<if (CONSTANT)> block will be optimized
|
|
away if the constant is false.
|
|
|
|
=head1 NOTES
|
|
|
|
As with all C<use> directives, defining a constant happens at
|
|
compile time. Thus, it's probably not correct to put a constant
|
|
declaration inside of a conditional statement (like C<if ($foo)
|
|
{ use constant ... }>).
|
|
|
|
Constants defined using this module cannot be interpolated into
|
|
strings like variables. However, concatenation works just fine:
|
|
|
|
print "Pi equals PI...\n"; # WRONG: does not expand "PI"
|
|
print "Pi equals ".PI."...\n"; # right
|
|
|
|
Even though a reference may be declared as a constant, the reference may
|
|
point to data which may be changed, as this code shows.
|
|
|
|
use constant ARRAY => [ 1,2,3,4 ];
|
|
print ARRAY->[1];
|
|
ARRAY->[1] = " be changed";
|
|
print ARRAY->[1];
|
|
|
|
Dereferencing constant references incorrectly (such as using an array
|
|
subscript on a constant hash reference, or vice versa) will be trapped at
|
|
compile time.
|
|
|
|
Constants belong to the package they are defined in. To refer to a
|
|
constant defined in another package, specify the full package name, as
|
|
in C<Some::Package::CONSTANT>. Constants may be exported by modules,
|
|
and may also be called as either class or instance methods, that is,
|
|
as C<< Some::Package->CONSTANT >> or as C<< $obj->CONSTANT >> where
|
|
C<$obj> is an instance of C<Some::Package>. Subclasses may define
|
|
their own constants to override those in their base class.
|
|
|
|
The use of all caps for constant names is merely a convention,
|
|
although it is recommended in order to make constants stand out
|
|
and to help avoid collisions with other barewords, keywords, and
|
|
subroutine names. Constant names must begin with a letter or
|
|
underscore. Names beginning with a double underscore are reserved. Some
|
|
poor choices for names will generate warnings, if warnings are enabled at
|
|
compile time.
|
|
|
|
=head2 List constants
|
|
|
|
Constants may be lists of more (or less) than one value. A constant
|
|
with no values evaluates to C<undef> in scalar context. Note that
|
|
constants with more than one value do I<not> return their last value in
|
|
scalar context as one might expect. They currently return the number
|
|
of values, but B<this may change in the future>. Do not use constants
|
|
with multiple values in scalar context.
|
|
|
|
B<NOTE:> This implies that the expression defining the value of a
|
|
constant is evaluated in list context. This may produce surprises:
|
|
|
|
use constant TIMESTAMP => localtime; # WRONG!
|
|
use constant TIMESTAMP => scalar localtime; # right
|
|
|
|
The first line above defines C<TIMESTAMP> as a 9-element list, as
|
|
returned by C<localtime()> in list context. To set it to the string
|
|
returned by C<localtime()> in scalar context, an explicit C<scalar>
|
|
keyword is required.
|
|
|
|
List constants are lists, not arrays. To index or slice them, they
|
|
must be placed in parentheses.
|
|
|
|
my @workdays = WEEKDAYS[1 .. 5]; # WRONG!
|
|
my @workdays = (WEEKDAYS)[1 .. 5]; # right
|
|
|
|
=head2 Defining multiple constants at once
|
|
|
|
Instead of writing multiple C<use constant> statements, you may define
|
|
multiple constants in a single statement by giving, instead of the
|
|
constant name, a reference to a hash where the keys are the names of
|
|
the constants to be defined. Obviously, all constants defined using
|
|
this method must have a single value.
|
|
|
|
use constant {
|
|
FOO => "A single value",
|
|
BAR => "This", "won't", "work!", # Error!
|
|
};
|
|
|
|
This is a fundamental limitation of the way hashes are constructed in
|
|
Perl. The error messages produced when this happens will often be
|
|
quite cryptic -- in the worst case there may be none at all, and
|
|
you'll only later find that something is broken.
|
|
|
|
When defining multiple constants, you cannot use the values of other
|
|
constants defined in the same declaration. This is because the
|
|
calling package doesn't know about any constant within that group
|
|
until I<after> the C<use> statement is finished.
|
|
|
|
use constant {
|
|
BITMASK => 0xAFBAEBA8,
|
|
NEGMASK => ~BITMASK, # Error!
|
|
};
|
|
|
|
=head2 Magic constants
|
|
|
|
Magical values and references can be made into constants at compile
|
|
time, allowing for way cool stuff like this. (These error numbers
|
|
aren't totally portable, alas.)
|
|
|
|
use constant E2BIG => ($! = 7);
|
|
print E2BIG, "\n"; # something like "Arg list too long"
|
|
print 0+E2BIG, "\n"; # "7"
|
|
|
|
You can't produce a tied constant by giving a tied scalar as the
|
|
value. References to tied variables, however, can be used as
|
|
constants without any problems.
|
|
|
|
=head1 TECHNICAL NOTES
|
|
|
|
In the current implementation, scalar constants are actually
|
|
inlinable subroutines. As of version 5.004 of Perl, the appropriate
|
|
scalar constant is inserted directly in place of some subroutine
|
|
calls, thereby saving the overhead of a subroutine call. See
|
|
L<perlsub/"Constant Functions"> for details about how and when this
|
|
happens.
|
|
|
|
In the rare case in which you need to discover at run time whether a
|
|
particular constant has been declared via this module, you may use
|
|
this function to examine the hash C<%constant::declared>. If the given
|
|
constant name does not include a package name, the current package is
|
|
used.
|
|
|
|
sub declared ($) {
|
|
use constant 1.01; # don't omit this!
|
|
my $name = shift;
|
|
$name =~ s/^::/main::/;
|
|
my $pkg = caller;
|
|
my $full_name = $name =~ /::/ ? $name : "${pkg}::$name";
|
|
$constant::declared{$full_name};
|
|
}
|
|
|
|
=head1 CAVEATS
|
|
|
|
In the current version of Perl, list constants are not inlined
|
|
and some symbols may be redefined without generating a warning.
|
|
|
|
It is not possible to have a subroutine or a keyword with the same
|
|
name as a constant in the same package. This is probably a Good Thing.
|
|
|
|
A constant with a name in the list C<STDIN STDOUT STDERR ARGV ARGVOUT
|
|
ENV INC SIG> is not allowed anywhere but in package C<main::>, for
|
|
technical reasons.
|
|
|
|
Unlike constants in some languages, these cannot be overridden
|
|
on the command line or via environment variables.
|
|
|
|
You can get into trouble if you use constants in a context which
|
|
automatically quotes barewords (as is true for any subroutine call).
|
|
For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will
|
|
be interpreted as a string. Use C<$hash{CONSTANT()}> or
|
|
C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from
|
|
kicking in. Similarly, since the C<< => >> operator quotes a bareword
|
|
immediately to its left, you have to say C<< CONSTANT() => 'value' >>
|
|
(or simply use a comma in place of the big arrow) instead of
|
|
C<< CONSTANT => 'value' >>.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Readonly> - Facility for creating read-only scalars, arrays, hashes.
|
|
|
|
L<Const> - Facility for creating read-only variables. Similar to C<Readonly>,
|
|
but uses C<SvREADONLY> instead of C<tie>.
|
|
|
|
L<Attribute::Constant> - Make read-only variables via attribute
|
|
|
|
L<Scalar::Readonly> - Perl extension to the C<SvREADONLY> scalar flag
|
|
|
|
L<Hash::Util> - A selection of general-utility hash subroutines (mostly
|
|
to lock/unlock keys and values)
|
|
|
|
=head1 BUGS
|
|
|
|
Please report any bugs or feature requests via the perlbug(1) utility.
|
|
|
|
=head1 AUTHORS
|
|
|
|
Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
|
|
many other folks.
|
|
|
|
Multiple constant declarations at once added by Casey West,
|
|
E<lt>F<casey@geeknest.com>E<gt>.
|
|
|
|
Documentation mostly rewritten by Ilmari Karonen,
|
|
E<lt>F<perl@itz.pp.sci.fi>E<gt>.
|
|
|
|
This program is maintained by the Perl 5 Porters.
|
|
The CPAN distribution is maintained by SE<eacute>bastien Aperghis-Tramoni
|
|
E<lt>F<sebastien@aperghis.net>E<gt>.
|
|
|
|
=head1 COPYRIGHT & LICENSE
|
|
|
|
Copyright (C) 1997, 1999 Tom Phoenix
|
|
|
|
This module is free software; you can redistribute it or modify it
|
|
under the same terms as Perl itself.
|
|
|
|
=cut
|