File Coverage

blib/lib/Module/Path/More.pm

Criterion	Covered	Total	%
statement	56	63	88.8
branch	26	42	61.9
condition	15	24	62.5
subroutine	6	7	85.7
pod	2	2	100.0
total	105	138	76.0

package Module::Path::More;

our $DATE = '2017-02-01'; # DATE
our $VERSION = '0.32'; # VERSION

use 5.010001;
use strict;
use warnings;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(module_path pod_path);

our $SEPARATOR;

our %SPEC;

$SPEC{':package'} = {
    v => 1.1,
    summary => 'Get path to locally installed Perl module',
};

BEGIN {
    if ($^O =~ /^(dos|os2)/i) {
        $SEPARATOR = '\\';
    } elsif ($^O =~ /^MacOS/i) {
        $SEPARATOR = ':';
    } else {
        $SEPARATOR = '/';
    }
}

$SPEC{module_path} = {
    v => 1.1,
    summary => 'Get path to locally installed Perl module',
    description => <<'_',

Search `@INC` (reference entries are skipped) and return path(s) to Perl module
files with the requested name.

This function is like the one from , except with a different
interface and more options (finding all matches instead of the first, the option
of not absolutizing paths, finding `.pmc` & `.pod` files, finding module
prefixes).

_
    args => {
        module => {
            summary => 'Module name to search',
            schema  => 'str*',
            req     => 1,
            pos     => 0,
        },
        find_pm => {
            summary => 'Whether to find .pm files',
            schema  => ['int*', min=>0],
            default => 1,
            description => <<'_',

The value of this option is an integer number from 0. 0 means to not search for
.pm files, while number larger than 0 means to search for .pm files. The larger
the number, the lower the priority. If more than one type is found (prefix, .pm,
.pmc, .pod) then the type with the lowest number is returned first.

_
        },
        find_pmc => {
            summary => 'Whether to find .pmc files',
            schema  => ['int*', min=>0],
            default => 2,
            description => <<'_',

The value of this option is an integer number from 0. 0 means to not search for
.pmc files, while number larger than 0 means to search for .pmc files. The
larger the number, the lower the priority. If more than one type is found
(prefix, .pm, .pmc, .pod) then the type with the lowest number is returned
first.

_
        },
        find_pod => {
            summary => 'Whether to find .pod files',
            schema  => ['int*', min=>0],
            default => 0,
            description => <<'_',

The value of this option is an integer number from 0. 0 means to not search for
.pod files, while number larger than 0 means to search for .pod files. The
larger the number, the lower the priority. If more than one type is found
(prefix, .pm, .pmc, .pod) then the type with the lowest number is returned
first.

_
        },
        find_prefix => {
            summary => 'Whether to find module prefixes',
            schema  => ['int*', min=>0],
            default => 0,
            description => <<'_',

The value of this option is an integer number from 0. 0 means to not search for
module prefix, while number larger than 0 means to search for module prefix. The
larger the number, the lower the priority. If more than one type is found
(prefix, .pm, .pmc, .pod) then the type with the lowest number is returned
first.

_
        },
        all => {
            summary => 'Return all results instead of just the first',
            schema  => 'bool',
            default => 0,
        },
        abs => {
            summary => 'Whether to return absolute paths',
            schema  => 'bool',
            default => 0,
        },
    },
    result => {
        schema => ['any' => of => ['str*', ['array*' => of => 'str*']]],
    },
    result_naked => 1,
    examples => [
        {
            summary => 'Find the first Foo::Bar (.pm or .pmc) in @INC',
            args => {module => 'Foo::Bar'},
        },
        {
            summary => 'Find all Foo::Bar (.pm or .pmc) in @INC, return absolute paths',
            args => {module => 'Foo::Bar', all => 1, abs => 1},
        },
        {
            summary => 'Find the Rinci (.pod first, then .pm) in @INC',
            args => {module => 'Rinci', find_pod => 1, find_pm => 2, find_pmc => 0},
        },
    ],
};
sub module_path {
    my %args = @_;

    my $module = $args{module} or die "Please specify module";

    $args{abs}         //= 0;
    $args{all}         //= 0;
    $args{find_pm}     //= 1;
    $args{find_pmc}    //= 2;
    $args{find_pod}    //= 0;
    $args{find_prefix} //= 0;

    require Cwd if $args{abs};

    my @res;
    my %unfound = (
        ("pm" => 1)     x !!$args{find_pm},
        ("pmc" => 1)    x !!$args{find_pmc},
        ("pod" => 1)    x !!$args{find_pod},
        ("prefix" => 1) x !!$args{find_prefix},
    );
    my $add = sub {
        my ($path, $prio) = @_;
        push @res, [$args{abs} ? Cwd::abs_path($path) : $path, $prio];
    };

    my $relpath;

    ($relpath = $module) =~ s/::/$SEPARATOR/g;
    $relpath =~ s/\.(pm|pmc|pod)\z//i;

    foreach my $dir (@INC) {
        next if not defined($dir);
        next if ref($dir);

        my $prefix = $dir . $SEPARATOR . $relpath;
        if ($args{find_pm}) {
            my $file = $prefix . ".pm";
            if (-f $file) {
                $add->($file, $args{find_pm});
                delete $unfound{pm};
                last if !keys(%unfound) && !$args{all};
            }
        }
        if ($args{find_pmc}) {
            my $file = $prefix . ".pmc";
            if (-f $file) {
                $add->($file, $args{find_pmc});
                delete $unfound{pmc};
                last if !keys(%unfound) && !$args{all};
            }
        }
        if ($args{find_pod}) {
            my $file = $prefix . ".pod";
            if (-f $file) {
                $add->($file, $args{find_pod});
                delete $unfound{pod};
                last if !keys(%unfound) && !$args{all};
            }
        }
        if ($args{find_prefix}) {
            if (-d $prefix) {
                $add->($prefix, $args{find_prefix});
                delete $unfound{prefix};
                last if !keys(%unfound) && !$args{all};
            }
        }
    }

    @res = map { $_->[0] } sort { $a->[1] <=> $b->[1] } @res;

    if ($args{all}) {
        return \@res;
    } else {
        return @res ? $res[0] : undef;
    }
}

$SPEC{pod_path} = {
    v => 1.1,
    summary => 'Get path to locally installed POD',
    description => <<'_',

This is a shortcut for:

    module_path(%args, find_pm=>0, find_pmc=>0, find_pod=>1, find_prefix=>0)

_
    args => {
        module => {
            summary => 'Module name to search',
            schema  => 'str*',
            req     => 1,
            pos     => 0,
        },
        all => {
            summary => 'Return all results instead of just the first',
            schema  => 'bool',
            default => 0,
        },
        abs => {
            summary => 'Whether to return absolute paths',
            schema  => 'bool',
            default => 0,
        },
    },
    result => {
        schema => ['any' => of => ['str*', ['array*' => of => 'str*']]],
    },
    result_naked => 1,
};
sub pod_path {
    module_path(@_, find_pm=>0, find_pmc=>0, find_pod=>1, find_prefix=>0);
}

1;
# ABSTRACT: Get path to locally installed Perl module

__END__