File Coverage

blib/lib/Extorter.pm

Criterion	Covered	Total	%
statement	47	52	90.3
branch	13	20	65.0
condition			n/a
subroutine	8	8	100.0
pod			n/a
total	68	80	85.0

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

use 5.10.0;

use strict;
use warnings;

use Import::Into;

our $VERSION = '0.09'; # 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;
        }

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

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

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

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

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

    return;
}

1;

__END__