File Coverage

blib/lib/Module/Want.pm

Criterion	Covered	Total	%
statement	68	70	97.1
branch	27	32	84.3
condition	27	35	77.1
subroutine	14	14	100.0
pod	10	10	100.0
total	146	161	90.6

package Module::Want;

use strict;
*normalize_ns            = \&get_clean_ns;    # do before warnings to prevent 'only used once' warning
*get_relative_path_of_ns = \&get_inc_key;     # do before warnings to prevent 'only used once' warning
use warnings;

$Module::Want::VERSION = '0.6';

my %lookup;

# Uncomment these 3 lines and '        # $tries{$ns}++;' in have_mod() for dev testing
# $Module::Want::DevTesting = 1;
# my %tries;
# sub _get_debugs_refs { return \%lookup, \%tries }

my $ns_regexp = qr/[A-Za-z_][A-Za-z0-9_]*(?:(?:\:\:|\')[A-Za-z0-9_]+)*/;

sub get_ns_regexp { return $ns_regexp }

sub is_ns { $_[0] =~ m/\A$ns_regexp\z/ }

sub get_all_use_require_in_text {
    return $_[0] =~ m/(?:^\s*|\;\s*|eval[^;]+)(?:use|require)\s+($ns_regexp)/g;
}

sub get_inc_key {
    return if !is_ns( $_[0] );

    # %INC keys are always unix format so no need for File::Spec
    #   if I've been misinformed of that fact then please let me know, thanks
    my $key = $_[0] . '.pm';
    $key =~ s{(?:\:\:|\')}{/}g;
    return $key;
}

sub distname2ns {
    my ($node) = @_;
    $node =~ s/-/::/g;
    my $ns = get_clean_ns($node);
    return $ns if is_ns($ns);
    return;
}

sub ns2distname {
    my $node = get_clean_ns( $_[0] );
    return if !is_ns($node);
    $node =~ s/::/-/g;
    return $node;
}

sub get_clean_ns {
    my $dirty = $_[0];
    $dirty =~ s{^\s+}{};
    $dirty =~ s{\s+$}{};
    $dirty =~ s{\'}{::}g;
    return $dirty;
}

sub have_mod {
    my ( $ns, $skip_cache ) = @_;
    $skip_cache ||= 0;

    if ( !is_ns($ns) ) {
        require Carp;
        Carp::carp('Invalid Namespace');
        return;
    }

    if ( $skip_cache || !exists $lookup{$ns} ) {

        $lookup{$ns} = 0;

        #        $tries{$ns}++;
        local $SIG{__DIE__};                       # prevent benign eval from tripping potentially fatal sig handler
        eval qq{require $ns;\$lookup{\$ns}++;};    ## no critic
    }

    return $lookup{$ns} if $lookup{$ns};
    return;
}

sub get_inc_path_via_have_mod {
    my ( $ns, $skip_cache ) = @_;
    return unless have_mod( $ns, $skip_cache );
    return $INC{ get_inc_key($ns) };
}

sub search_inc_paths {
    my ( $ns, $want_abs ) = @_;

    have_mod('File::Spec') || return;

    my $rel_path = File::Spec->catfile( split( m{/}, get_relative_path_of_ns($ns) ) );
    my $return_first = wantarray ? 0 : 1;
    my @result;

    for my $path (@INC) {
        my $abspath = File::Spec->rel2abs( $rel_path, $path );
        if ( -f $abspath ) {
            push @result, ( $want_abs ? $abspath : $path );
            last if $return_first;
        }
    }

    if (@result) {
        return $result[0] if $return_first;
        return @result;
    }
    return;
}

sub import {
    shift;

    my $caller = caller();

    no strict 'refs';    ## no critic
    *{ $caller . '::have_mod' } = \&have_mod;

    for my $ns (@_) {
        next if $ns eq 'have_mod';

        if ( $ns eq 'is_ns' || $ns eq 'get_inc_key' || $ns eq 'get_clean_ns' || $ns eq 'get_ns_regexp' || $ns eq 'get_all_use_require_in_text' || $ns eq 'get_relative_path_of_ns' || $ns eq 'normalize_ns' || $ns eq 'get_inc_path_via_have_mod' || $ns eq 'search_inc_paths' || $ns eq 'distname2ns' || $ns eq 'ns2distname' ) {
            *{ $caller . "::$ns" } = \&{$ns};
        }
        else {
            have_mod($ns);
        }
    }
}

1;

__END__