File Coverage

blib/lib/constant/tiny.pm

Criterion	Covered	Total	%
statement	11	11	100.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	15	15	100.0

package constant::tiny;
return 1 if $INC{"constant.pm"};
$INC{"constant.pm"} = $INC{+__FILE__};
$VERSION = "1.02";

package # hide from PAUSE
        constant;
use 5.010;
use strict;


$constant::VERSION = $constant::tiny::VERSION;

my %forbidden = map +($_, 1), qw<
    BEGIN INIT CHECK END DESTROY AUTOLOAD UNITCHECK
    STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG
>;

my $normal_constant_name = qr/^_?[A-Za-z0-9][A-Za-z0-9_]+\z/;


#
# 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.
#
*import = sub {
    my $class = shift;
    return unless @_;  # ignore "use constant;"

    if (not defined $_[0]) {
        require Carp;
        Carp::croak("Can't use undef as constant name");
    }

    my $multiple = ref $_[0];
    if ($multiple and $multiple ne "HASH") {
        require Carp;
        Carp::croak("Invalid reference type '$multiple'");
    }

    my $constants = $multiple ? shift : { shift() => undef };
    my $flush_mro;
    my $pkg = caller();
    my $symtab;
    { no strict 'refs'; $symtab = \%{$pkg . '::'} }

    foreach my $name (keys %$constants) {
        # Normal constant name
        if ($name !~ $normal_constant_name or $forbidden{$name}) {
            require Carp;
            Carp::croak("Invalid name '$name'");
        }

        no strict 'refs';
        my $full_name = "${pkg}::$name";

        if ($multiple || @_ == 1) {
            my $scalar = $multiple ? $constants->{$name} : $_[0];

            if ($symtab && !exists $symtab->{$name}) {
                Internals::SvREADONLY($scalar, 1);
                $symtab->{$name} = \$scalar;
                ++$flush_mro;
            } else {
                my $scalar = $scalar;
                *$full_name = sub () { $scalar };
            }
        } elsif (@_) {
            my @list = @_;
            *$full_name = sub () { @list };
        } else {
            *$full_name = sub () { };
        }
    }

    mro::method_changed_in($pkg) if $flush_mro;
};


q< IN CONSTANT TIME >

__END__