File Coverage

blib/lib/first.pm

Criterion	Covered	Total	%
statement	27	71	38.0
branch	1	32	3.1
condition			n/a
subroutine	8	10	80.0
pod	0	2	0.0
total	36	115	31.3

package first;

use strict;
use warnings;
use Carp;

use version;our $VERSION = qv('0.0.1');

# require UNIVERSAL::require;
# until http://rt.cpan.org/Ticket/Display.html?id=24741 is added we'll inlcude it at the end

our $module;
our $failed = {};

sub import {
    my $self = shift;
    my %flags = map { $_ => 1,} grep(/^-/, @_);

    $module = undef;

    local $UNIVERSAL::Level = $UNIVERSAL::Level + 1; # || -level=1 + 1

    for my $ns (grep !/^-/, @_) {
        next if !defined$ns;

        my $nms = $ns; # copy to possibly modify
        my @imp;

        if(ref $ns eq 'ARRAY') {
            $nms = shift @{ $ns };
            @imp = @{ $ns };
        }

        if( @imp ? $nms->use( @imp ) : $nms->use ) {
            $module = $nms;
            last;
        }
        else {
            $failed->{ $nms } = $@;
        }
    }

    if( keys %{ $failed } ) {
        my $msg = "Could not load these modules:\n\t" . join("\n\t", keys %{ $failed }) . "\n";
        carp  $msg if exists $flags{'-carp'};
        croak $msg if exists $flags{'-croak'};
    }

    return $module;
}

################################
#### start UNIVERSAL::require ##
################################

# UNIVERSAL-require-0.11
# sans POD, and with http://rt.cpan.org/Ticket/Display.html?id=24741

package UNIVERSAL::require;
$UNIVERSAL::require::VERSION = '0.11';

# We do this because UNIVERSAL.pm uses CORE::require().  We're going
# to put our own require() into UNIVERSAL and that makes an ambiguity.
# So we load it up beforehand to avoid that.
BEGIN { require UNIVERSAL }

package UNIVERSAL;

use strict;

use vars qw($Level);
$Level = 0;

sub require {
    my($module, $want_version) = @_;

    $UNIVERSAL::require::ERROR = '';

    die("UNIVERSAL::require() can only be run as a class method")
      if ref $module;

    die("UNIVERSAL::require() takes no or one arguments") if @_ > 2;

    my($call_package, $call_file, $call_line) = caller($Level);

    # Load the module.
    my $file = $module . '.pm';
    $file =~ s{::}{/}g;

    # For performance reasons, check if its already been loaded.  This makes
    # things about 4 times faster.
    return 1 if $INC{$file};

    my $return = eval qq{
#line $call_line "$call_file"
CORE::require(\$file);
};

    # Check for module load failure.
    if( $@ ) {
        $UNIVERSAL::require::ERROR = $@;
        return $return;
    }

    # Module version check.
    if( @_ == 2 ) {
        eval qq{
#line $call_line "$call_file"
\$module->VERSION($want_version);
};

        if( $@ ) {
            $UNIVERSAL::require::ERROR = $@;
            return 0;
        }
    }

    return $return;
}

sub use {
    my($module, @imports) = @_;

    local $Level = $Level ? $Level : 1;
    my $return = $module->require or return 0;

    my($call_package, $call_file, $call_line) = caller;

    eval qq{
package $call_package;
#line $call_line "$call_file"
\$module->import(\@imports);
};

    if( $@ ) {
        $UNIVERSAL::require::ERROR = $@;
        return 0;
    }

    return $return;
}

##############################
#### end UNIVERSAL::require ##
##############################

1;

__END__