| Current File : //var/tmp/par-streamof/cache-019bf52da828c7d4df54624dfe058723871c67b9/86bc8fad.pm |
#line 1 "/usr/local/lib/perl5/5.8.8/constant.pm"
package constant;
use strict;
use 5.006_00;
use warnings::register;
our($VERSION, %declared);
$VERSION = '1.05';
#=======================================================================
# Some names are evil choices.
my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
my %forced_into_main = map +($_, 1),
qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
my %forbidden = (%keywords, %forced_into_main);
#=======================================================================
# 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];
if ( $multiple ) {
if (ref $_[0] ne 'HASH') {
require Carp;
Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
}
%constants = %{+shift};
} else {
$constants{+shift} = undef;
}
foreach my $name ( keys %constants ) {
unless (defined $name) {
require Carp;
Carp::croak("Can't use undef as constant name");
}
my $pkg = caller;
# Normal constant name
if ($name =~ /^_?[^\W_0-9]\w*\z/ 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 =~ /^[A-Za-z_]\w*\z/) {
# 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 =~ /^[01]?\z/) {
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) {
my $scalar = $constants{$name};
*$full_name = sub () { $scalar };
} else {
if (@_ == 1) {
my $scalar = $_[0];
*$full_name = sub () { $scalar };
} elsif (@_) {
my @list = @_;
*$full_name = sub () { @list };
} else {
*$full_name = sub () { };
}
}
}
}
}
1;
__END__
#line 341