File Coverage

blib/lib/lib/xi.pm

Criterion	Covered	Total	%
statement	61	65	93.8
branch	15	20	75.0
condition	3	8	37.5
subroutine	10	11	90.9
pod	0	5	0.0
total	89	109	81.6

package lib::xi;
use 5.008_001;
use strict;
use warnings FATAL => 'all';

our $VERSION = '1.03';

use File::Spec ();
use Config ();

our $VERBOSE;

# modules which dosn't exist in CPAN
our %IGNORE = map { $_ => 1 } (
    'Encode/ConfigLocal.pm',
    'Devel/StackTraceFrame.pm',
    'Log/Agent.pm', # used in Storable.pm
);

sub new {
    my($class, %args) = @_;
    return bless \%args, $class;
}

sub run_perl {
    my(@args) = @_;

    my %std_inc = map  { $_ => 1 }
                  grep { defined($_) && length } @Config::Config{qw(
          sitelibexp   sitearchexp
        venderlibexp venderarchexp
          privlibexp    archlibexp
    )};
    my @non_std_inc = map { File::Spec->rel2abs($_) }
                      grep { defined($_) && not $std_inc{$_} } @INC;

    system($^X, (map { "-I$_" } @non_std_inc), @args);
}

sub cpanm_command {
    my($self) = @_;
    return('cpanm', @{ $self->{cpanm_opts} });
}

# must be fully-qualified; othewise implied main::INC.
sub lib::xi::INC {
    my($self, $file) = @_;

    return if $IGNORE{$file};

    my $module = $file;
    $module =~ s/\.pm \z//xms;
    $module =~ s{/}{::}xmsg;

    my @cmd = ($self->cpanm_command, $module);
    if($VERBOSE) {
        print STDERR "# PERL_CPANM_OPT: ", ($ENV{PERL_CPANM_OPT} || '') ,"\n";
        print STDERR "# COMMAND: @cmd\n";
    }
    if(run_perl('-S', @cmd) == 0) {
        foreach my $lib (grep {defined} @{ $self->{myinc} }) {
            if(open my $inh, '<', "$lib/$file") {
                $INC{$file} = "$lib/$file";
                return $inh;
            }
        }
    }

    # fall back to the default behavior (Can't locate Foo.pm ...)
    return;
}

sub import {
    my($class, @cpanm_opts) = @_;

    my $install_dir;

    if(@cpanm_opts && $cpanm_opts[0] !~ /^-/) {
        require File::Spec;
        my $base;
        if($0 ne '-e' && -e $0) {
            my($volume, $dir, undef) = File::Spec->splitpath($0);
            $base = File::Spec->catpath($volume, $dir, '');
        }
        $install_dir = File::Spec->rel2abs(shift(@cpanm_opts), $base);
    }

    my @myinc;

    if($install_dir) {
        @myinc = (
            "$install_dir/lib/perl5/$Config::Config{archname}",
            "$install_dir/lib/perl5",
        );
        unshift @INC, @myinc;

        unshift @cpanm_opts, '-l', $install_dir;
    }

    $VERBOSE = scalar grep { $_ eq '-v' } @cpanm_opts;

    push @INC, $class->new(
        install_dir => $install_dir,
        myinc       => $install_dir ? \@myinc : \@INC,
        cpanm_opts  => \@cpanm_opts,
    );
    return;
}

sub install_dir { $_[0]->{install_dir} } # for testing

1;
__END__