File Coverage

blib/lib/Devel/SearchINC.pm

Criterion	Covered	Total	%
statement	59	67	88.0
branch	25	36	69.4
condition	13	18	72.2
subroutine	10	10	100.0
pod	1	1	100.0
total	108	132	81.8

use 5.008;
use strict;
use warnings;

package Devel::SearchINC;
BEGIN {
  $Devel::SearchINC::VERSION = '2.103460';
}
# ABSTRACT: Loading Perl modules from their development directories
use Data::Dumper;
use File::Find;

sub build_cache {
    our %cache = ();
    our @PATHS;
    return unless @PATHS;
    our $DEBUG;

    # Programs run with -T cause a "Insecure dependency in chdir while running
    # with -T switch" warning, so untaint directory names.
    find(
        {   untaint         => 1,
            untaint_pattern => qr|^(.+)$|,  # File::Find gets this wrong on OS X
            untaint_skip    => 1,
            follow          => 1,
            wanted          => sub {
                warn "dir [$File::Find::name]\n" if $DEBUG && -d;
                if (-d && /^(t|CVS|\.svn|\.git|skel|_build)$/) {
                    warn "$File::Find::name dir will be pruned\n" if $DEBUG;
                    $File::Find::prune = 1;
                    return;
                }
                if (-d && -e "$File::Find::name/INC.SKIP") {
                    warn "$File::Find::name dir contains INC.SKIP; pruned\n"
                      if $DEBUG;
                    $File::Find::prune = 1;
                    return;
                }
                if (-d && $_ eq 'lib') {
                    push our @inc => $File::Find::name;
                    return;
                }
                return unless -f && /\.pm$/;
                if ($File::Find::name =~ m!.*/(?:lib|blib/(?:lib|arch))/(.*)!) {
                    $cache{$1} ||= $File::Find::name;
                }
              }
        },
        @PATHS
    );
    warn "cache:\n", Dumper \%cache if $DEBUG;
}

BEGIN {
    unshift @INC, sub {
        my ($self, $file) = @_;
        our %cache;
        our $DEBUG;
        unless (exists $cache{$file}) {
            printf "%s: cache miss <%s>\n", __PACKAGE__, $file
              if $DEBUG;
            return;
        }
        printf "%s: found <%s>\n", __PACKAGE__, $cache{$file} if $DEBUG;
        if (open(my $fh, '<', $cache{$file})) {
            $INC{$file} = $cache{$file};
            return $fh;
        }
        printf "%s: can't open <%s>, declining\n", __PACKAGE__, $cache{$file}
          if $DEBUG;
        return;
      }
}

sub import {
    shift;    # we don't need the package name
    our $DEBUG = 0;
    my @p =
      map { s/^~/$ENV{HOME}/; $_ }
      map { split /\s*[,;:]\s*/ } @_;
    our @PATHS;
    for my $path (@p) {
        if ($path eq '-debug') {
            $DEBUG = 1;
            next;
        }
        if ($path eq '-clear') {
            @PATHS = ();
            next;
        }
        push @PATHS => $path;
    }

    # Build the module cache anew after each import; this is so that if you
    # use PERL5OPT=-MDevel::SearchINC=... and then a program loads it
    # separately with "use Devel::SearchINC '...'" paths from both occasions
    # get respected.
    build_cache();
    warn "paths:\n", Dumper \@PATHS if $DEBUG;
}
1;


__END__