File Coverage

blib/lib/Extorter.pm

Criterion	Covered	Total	%
statement	51	56	91.0
branch	15	22	68.1
condition	8	12	66.6
subroutine	8	8	100.0
pod			n/a
total	82	98	83.6

# ABSTRACT: Import Routines By Any Means Necessary
package Extorter;

use 5.10.0;

use strict;
use warnings;

use Import::Into;

our $VERSION = '0.10'; # VERSION

sub import {
    my $class  = shift;
    my $target = caller;

    my @imports = @_ or return;
    $class->extort::into($target, $_) for @imports;

    return;
}

sub extort::into {
    my $class  = shift;
    my $target = shift;

    my @imports = @_ or return;

    @imports = map join('::', $imports[0], $_), @imports[1..$#imports]
        if @imports > 1;

    my %seen;
    for my $import (@imports) {
        my @captures = $import =~ /^(\w.+)(?:\^|::)(.*)/;
           @captures = $import =~ /^\*(.+)/ unless @captures;

        my ($namespace, $argument) = @captures;
        next unless $namespace;

        unless ($argument) {
            $namespace->import::into($target);
            next;
        }

        my $subname;
        if ($argument and $argument =~ /=/) {
            ($argument, $subname) = split /=/, $argument;
        }

        $seen{$namespace}++
            || eval "require $namespace";

        if (!$subname and $argument =~ /\W/) {
            $namespace->import::into($target, $argument);
            next;
        }

        no strict 'refs';
        my %EXPORT_TAGS = %{"${namespace}::EXPORT_TAGS"};
        if (!$subname and $EXPORT_TAGS{$argument}) {
            $namespace->import::into($target, $argument);
            next;
        }

        if ($namespace->can($argument)) {
            no warnings 'redefine';
            $subname //= $argument;
            *{"${target}::${subname}"} = \&{"${namespace}::${argument}"};
            next;
        }

        # fallback
        $namespace->import::into($target, $argument);
    }

    return;
}

1;

__END__