File Coverage

blib/lib/Constant/Exporter.pm

Criterion	Covered	Total	%
statement	48	49	97.9
branch	9	14	64.2
condition	1	2	50.0
subroutine	5	6	83.3
pod			n/a
total	63	71	88.7

package Constant::Exporter;
use strict;
use warnings;
our $VERSION = '0.01';
require Exporter;

sub import {
    my ($class, %args) = @_;
    my (@export, @export_ok, %export_tags, %constants);

    for my $key (qw/ EXPORT_TAGS EXPORT_OK_TAGS /) {
        for my $tag (keys %{ $args{$key} || {} }) {
            $export_tags{$tag} ||= [];
            for my $name (keys %{ $args{$key}->{$tag} || {} }) {
                $constants{$name} = $args{$key}->{$tag}{$name};
                push @{$export_tags{$tag}}, $name;

                if ($key eq 'EXPORT_TAGS') {
                    push @export, $name;
                } elsif ($key eq 'EXPORT_OK_TAGS') {
                    push @export_ok, $name;
                }
            }
        }
    }

    for my $key (qw/ EXPORT EXPORT_OK /) {
        for my $name (keys %{ $args{$key} || {} }) {
            $constants{$name} = $args{$key}->{$name};
            if ($key eq 'EXPORT') {
                push @export, $name;
            } elsif ($key eq 'EXPORT_OK') {
                push @export_ok, $name;
            }
        }
    }

    my $pkg = caller;

    {
        no strict 'refs';
        for my $name (keys %constants) {
            my $value = $constants{$name};
            *{"${pkg}::${name}"} = sub () { $value };
        }

        push @{"${pkg}::ISA"}, 'Exporter';
        push @{"${pkg}::EXPORT"}, @export;
        push @{"${pkg}::EXPORT_OK"}, @export_ok;
        %{"${pkg}::EXPORT_TAGS"} = %export_tags;

        *{"${pkg}::import"} = sub {
            my $pkg = shift;
            $pkg->export_to_level(1, undef, @_)
        };
    }
}

1;
__END__