File Coverage

blib/lib/constant/tiny.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package constant::tiny;
2             return 1 if $INC{"constant.pm"};
3             $INC{"constant.pm"} = $INC{+__FILE__};
4             $VERSION = "1.01";
5              
6             package # hide from PAUSE
7             constant;
8 2     2   1372 use 5.010;
  2         7  
  2         71  
9 2     2   11 use strict;
  2         3  
  2         472  
10              
11              
12             $constant::VERSION = $constant::tiny::VERSION;
13              
14             my %forbidden = map +($_, 1), qw<
15             BEGIN INIT CHECK END DESTROY AUTOLOAD UNITCHECK
16             STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG
17             >;
18              
19             my $normal_constant_name = qr/^_?[A-Za-z0-9][A-Za-z0-9_]+\z/;
20              
21              
22             #
23             # import()
24             # ------
25             # import symbols into user's namespace
26             #
27             # What we actually do is define a function in the caller's namespace
28             # which returns the value. The function we create will normally
29             # be inlined as a constant, thereby avoiding further sub calling
30             # overhead.
31             #
32             *import = sub {
33             my $class = shift;
34             return unless @_; # ignore "use constant;"
35              
36             if (not defined $_[0]) {
37             require Carp;
38             Carp::croak("Can't use undef as constant name");
39             }
40              
41             my $multiple = ref $_[0];
42             if ($multiple and $multiple ne "HASH") {
43             require Carp;
44             Carp::croak("Invalid reference type '$multiple'");
45             }
46              
47             my $constants = $multiple ? shift : { shift() => undef };
48             my $flush_mro;
49             my $pkg = caller();
50             my $symtab;
51 2     2   19 { no strict 'refs'; $symtab = \%{$pkg . '::'} }
  2         4  
  2         192  
52              
53             foreach my $name (keys %$constants) {
54             # Normal constant name
55             if ($name !~ $normal_constant_name or $forbidden{$name}) {
56             require Carp;
57             Carp::croak("Invalid name '$name'");
58             }
59              
60 2     2   10 no strict 'refs';
  2         5  
  2         559  
61             my $full_name = "${pkg}::$name";
62              
63             if ($multiple || @_ == 1) {
64             my $scalar = $multiple ? $constants->{$name} : $_[0];
65              
66             if ($symtab && !exists $symtab->{$name}) {
67             Internals::SvREADONLY($scalar, 1);
68             $symtab->{$name} = \$scalar;
69             ++$flush_mro;
70             } else {
71             *$full_name = sub () { $scalar };
72             }
73             } elsif (@_) {
74             my @list = @_;
75             *$full_name = sub () { @list };
76             } else {
77             *$full_name = sub () { };
78             }
79             }
80              
81             mro::method_changed_in($pkg) if $flush_mro;
82             };
83              
84              
85             q< IN CONSTANT TIME >
86              
87             __END__