File Coverage

blib/lib/Import/Base.pm

Criterion	Covered	Total	%
statement	118	120	98.3
branch	39	42	92.8
condition	4	5	80.0
subroutine	12	12	100.0
pod	2	2	100.0
total	175	181	96.6

package Import::Base;
# ABSTRACT: Import a set of modules into the calling module
our $VERSION = '1.004';

use strict;
use warnings;
use mro ();
use Import::Into;
use Module::Runtime qw( use_module );

require Exporter;

our @ISA = qw(Exporter);

sub modules {
    my ( $class, $bundles, $args ) = @_;
    my @modules = ();

    # Find all the modules from the static API
    # Reverse the array to allow more-specific classes to override
    # less-specific ones
    for my $pkg ( reverse @{ mro::get_linear_isa( $class ) } ) {
        no strict 'refs';
        no warnings 'once';

        if ( !$args->{bundles_only} ) {
            push @modules, @{ $pkg . "::IMPORT_MODULES" };
        }

        my %bundles = %{ $pkg . "::IMPORT_BUNDLES" };
        push @modules, map { @{ $bundles{ $_ } } }
            grep { exists $bundles{ $_ } }
            @$bundles;
    }

    return @modules;
}

sub _parse_args {
    my ( $class, @args ) = @_;
    my @bundles;
    while ( @args ) {
        last if $args[0] =~ /^-/;
        push @bundles, shift @args;
    }
    my %args = @args;
    return ( \@bundles, \%args );
}

sub import_bundle {
    my ( $class, @args ) = @_;
    my ( $bundles, $args ) = $class->_parse_args( @args );

    # Add internal Import::Base args
    $args->{package} = scalar caller(0);
    $args->{bundles_only} = 1;

    my @modules = $class->modules( $bundles, $args );
    $class->_import_modules( \@modules, $bundles, $args );
}

sub import {
    my ( $class, @args ) = @_;
    my ( $bundles, $args ) = $class->_parse_args( @args );

    # Add internal Import::Base args
    $args->{package} = scalar caller(0);

    my @modules = $class->modules( $bundles, $args );
    $class->_import_modules( \@modules, $bundles, $args );
}

sub _import_modules {
    my ( $class, $modules, $bundles, $args ) = @_;

    die "Argument to -exclude must be arrayref"
        if $args->{-exclude} && ref $args->{-exclude} ne 'ARRAY';
    my $exclude = {};
    if ( $args->{-exclude} ) {
        while ( @{ $args->{-exclude} } ) {
            my $module = shift @{ $args->{-exclude} };
            my $subs = ref $args->{-exclude}[0] eq 'ARRAY' ? shift @{ $args->{-exclude} } : undef;
            $exclude->{ $module } = $subs;
        }
    }

    # Add internal Import::Base args
    $args->{package} ||= scalar caller(0);

    my @modules = @$modules;
    my @cb_args = ( $bundles, $args );

    # Prepare the modules to load
    # First pass determines the order to load
    my ( @first_load, @last_load );
    while ( @modules ) {
        if ( ref $modules[0] eq 'CODE' ) {
            push @first_load, shift @modules;
            next;
        }

        my $thing = shift @modules;
        my $module;
        my $version;
        if ( ref $thing eq 'HASH' ) {
            ( $module, $version ) = %$thing;
        }
        else {
            $module = $thing;
        }
        my $imports = ref $modules[0] eq 'ARRAY' ? shift @modules : [];

        # Determine the module order
        if ( $module =~ /^
            $module =~ s/^
            if ( defined $version ) {
                unshift @first_load, { $module => $version } => $imports;
            }
            else {
                unshift @first_load, $module => $imports;
            }
        }
        elsif ( $module =~ /^>/ ) {
            $module =~ s/^>//;
            if ( defined $version ) {
                push @last_load, { $module => $version } => $imports;
            }
            else {
                push @last_load, $module => $imports;
            }
        }
        else {
            push @first_load, $thing => $imports;
        }
    }

    # Second pass loads the modules
    my @loads = ( @first_load, @last_load );
    while ( my $load = shift @loads ) {
        my $module;
        my $version;
        if ( ref $load eq 'CODE' ) {
            unshift @loads, $load->( @cb_args );
            next;
        }
        elsif ( ref $load eq 'HASH' ) {
            ( $module, $version ) = %$load;
        }
        else {
            $module = $load;
        }

        my $imports = ref $loads[0] eq 'ARRAY' ? shift @loads : [];

        if ( exists $exclude->{ $module } ) {
            if ( defined $exclude->{ $module } ) {
                my @left;
                for my $import ( @$imports ) {
                    push @left, $import
                        unless grep { $_ eq $import } @{ $exclude->{ $module } };
                }
                $imports = \@left;
            }
            else {
                next;
            }
        }

        my $method = 'import::into';
        if ( $module =~ /^-/ ) {
            $method = 'unimport::out_of';
            $module =~ s/^-//;
        }

        if ($module->isa("Import::Base")) {
            $module->export_to_level( 2, $module, @{ $imports } );

            next;
        }

        use_module( $module );
        if ( defined $version ) {
            $module->$method( { level => 2, version => $version }, @{ $imports } );
        }
        else {
            $module->$method( 2, @{ $imports } );
        }
    }
}

1;

__END__