File Coverage

blib/lib/Import/Into/As.pm

Criterion	Covered	Total	%
statement	60	62	96.7
branch	25	30	83.3
condition	6	9	66.6
subroutine	8	8	100.0
pod			n/a
total	99	109	90.8

package Import::Into::As;
use strict;
use warnings;

our $VERSION = '0.000001';

use Import::Into;
use Carp qw/croak/;

sub import::into::as {
    my $class = shift;
    my ($target, $rename, @args) = @_;

    # need to bump level by 2, 1 for the call to _get_imported_syms,
    # another for the call to import::into
    my $bump_level = 2;

    my ($dest, $level);

    if (ref $target) {
        $dest = $target->{package} if exists $target->{package};
        if (exists $target->{level}) {
            $level = $target->{level};
            $dest  ||= caller($level);
            $target->{level} += $bump_level;
        }
    }
    elsif ($target =~ m/^\d+$/) {
        $level = $target;
        $dest  = caller($level);
        $target += $bump_level;
    }
    else {
        $dest = $target;
    }

    croak "unable to find destination package!"
        unless $dest;

    # Get all the symbols that should be imported. This is a hashref of symbol
    # names where value is an arrayref of glob entries.
    my %syms = _get_imported_syms($class, $target, \@args, $dest);

    # Load each import symbol into the destination namespace
    for my $sym (keys %syms) {
        next if $sym eq '__ANON__';

        # Coderefs can be renamed.
        my $subname = $rename->{$sym} || $sym;

        no strict 'refs';

        # Only support the big 4 types in the glob.
        *{"$dest\::$subname"} = $syms{$sym}{CODE}   if $syms{$sym}{CODE};
        *{"$dest\::$sym"}     = $syms{$sym}{SCALAR} if $syms{$sym}{SCALAR};
        *{"$dest\::$sym"}     = $syms{$sym}{HASH}   if $syms{$sym}{HASH};
        *{"$dest\::$sym"}     = $syms{$sym}{ARRAY}  if $syms{$sym}{ARRAY};
    }
}

# This will import the symbols into the desired namespace, but will localize
# the namespace to ensure no changes are actually made. It will then return all
# the symbols that were imported into the namespace and restore the
# namespace to its previous state.
sub _get_imported_syms {
    my ($module, $target, $args, $dest) = @_;

    # This block does some crazy things, we need to turn off strict refs
    no strict 'refs';

    # Localize the entire destination namespace so that we don't actually do
    # anything to it. This also means we do not need to turn off redefine
    # warnings.
    local *{"$dest\::"};

    # Import into the namespace we just protected with local.
    $module->import::into($target, @$args);

    # Generate a (sym => { CODE => ..., SCALAR => ..., ... }, ...) hash.
    return map {
        my $code   = *{"$dest\::$_"}{CODE};
        my $array  = *{"$dest\::$_"}{ARRAY};
        my $hash   = *{"$dest\::$_"}{HASH};
        my $scalar = *{"$dest\::$_"}{SCALAR};

        # Scalars in globs are crazy... this is "good enough", though it will
        # fail for anonymous scalar exports that are set to undef.
        $scalar = undef unless defined($$scalar) || $scalar == \${"$module\::$_"};

        $_ => {
            $code   ? (CODE   => $code)   : (),
            $array  ? (ARRAY  => $array)  : (),
            $hash   ? (HASH   => $hash)   : (),
            $scalar ? (SCALAR => $scalar) : (),
        }
    } keys %{"$dest\::"};
}

1;

__END__