File Coverage

blib/lib/Complete/Module.pm

Criterion	Covered	Total	%
statement	68	68	100.0
branch	31	34	91.1
condition	33	35	94.2
subroutine	8	8	100.0
pod	1	1	100.0
total	141	146	96.5

package Complete::Module;

our $DATE = '2021-02-06'; # DATE
our $VERSION = '0.262'; # VERSION

use 5.010001;
use strict;
use warnings;
#use Log::Any '$log';

use Complete::Common qw(:all);
use List::Util qw(uniq);

our %SPEC;
require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(complete_module);

our $OPT_SHORTCUT_PREFIXES;
if ($ENV{COMPLETE_MODULE_OPT_SHORTCUT_PREFIXES}) {
    $OPT_SHORTCUT_PREFIXES =
        { split /=|;/, $ENV{COMPLETE_MODULE_OPT_SHORTCUT_PREFIXES} };
} else {
    $OPT_SHORTCUT_PREFIXES = {
        #cp  => 'Catalyst/Plugin/' # candidate
        df  => 'DateTime/Format/',
        #dp  => 'Dancer/Plugin/', # candidate
        #d2p  => 'Dancer2/Plugin/', # candidate
        dz  => 'Dist/Zilla/',
        dzb => 'Dist/Zilla/PluginBundle/',
        dzp => 'Dist/Zilla/Plugin/',
        dzr => 'Dist/Zilla/Role/',
        #pa  => 'Plack/App/', # candidate
        #pc  => 'POE/Component/', # candidate
        #pc  => 'Perl/Critic/', # candidate?
        #pcp => 'Perl/Critic/Policy/', # candidate?
        #pd  => 'Padre/Document/', # candidate
        #pm  => 'Plack/Middleware/', # candidate
        #pp  => 'Padre/Plugin/', # candidate
        pw  => 'Pod/Weaver/',
        pwb => 'Pod/Weaver/PluginBundle/',
        pwp => 'Pod/Weaver/Plugin/',
        pwr => 'Pod/Weaver/Role/',
        pws => 'Pod/Weaver/Section/',
        #rtx => 'RT/Extension/', # candidate
        #se  => 'Search/Elasticsearch/', # candidate
        #sec => 'Search/Elasticsearch/Client/', # candidate
        #ser => 'Search/Elasticsearch/Role/', # candidate
        #tp  => 'Template/Plugin/', # candidate
        #tw  => 'Tickit/Widget/', # candidate

        # MooseX, MooX
        # Moose::Exception
        # Finance::Bank
        # Mojo::*, MojoX::*, Mojolicious::*
    };
}

$SPEC{complete_module} = {
    v => 1.1,
    summary => 'Complete with installed Perl module names',
    description => <<'_',

For each directory in `@INC` (coderefs are ignored), find Perl modules and
module prefixes which have `word` as prefix. So for example, given `Te` as
`word`, will return e.g. `[Template, Template::, Term::, Test, Test::, Text::]`.
Given `Text::` will return `[Text::ASCIITable, Text::Abbrev, ...]` and so on.

This function has a bit of overlapping functionality with , but
this function is geared towards shell tab completion. Compared to Module::List,
here are some differences: 1) list modules where prefix is incomplete; 2)
interface slightly different; 3) (currently) doesn't do recursing; 4) contains
conveniences for completion, e.g. map casing, expand intermediate paths (see
`Complete` for more details on those features), autoselection of path separator
character, some shortcuts, and so on.

_
    args => {
        %arg_word,
        path_sep => {
            summary => 'Path separator',
            schema  => 'str*',
            description => <<'_',

For convenience in shell (bash) completion, instead of defaulting to `::` all
the time, will look at `word`. If word does not contain any `::` then will
default to `/`. This is because `::` (contains colon) is rather problematic as
it is by default a word-break character in bash and the word needs to be quoted
to avoid word-breaking by bash.

_
        },
        find_pm => {
            summary => 'Whether to find .pm files',
            schema  => 'bool*',
            default => 1,
        },
        find_pod => {
            summary => 'Whether to find .pod files',
            schema  => 'bool*',
            default => 1,
        },
        find_pmc => {
            summary => 'Whether to find .pmc files',
            schema  => 'bool*',
            default => 1,
        },
        find_prefix => {
            summary => 'Whether to find module prefixes',
            schema  => 'bool*',
            default => 1,
        },
        ns_prefix => {
            summary => 'Namespace prefix',
            schema  => 'perl::modname*',
            description => <<'_',

This is useful if you want to complete module under a specific namespace
(instead of the root). For example, if you set `ns_prefix` to
`Dist::Zilla::Plugin` (or `Dist::Zilla::Plugin::`) and word is `F`, you can get
`['FakeRelease', 'FileFinder::', 'FinderCode']` (those are modules under the
`Dist::Zilla::Plugin::` namespace).

_
        },
        ns_prefixes => {
            summary => 'Namespace prefixes',
            schema => ['array*', of=>'perl::modname*'],
            description => <<'_',

If you specify this instead of `ns_prefix`, then the routine will search from
all the prefixes instead of just one.

_
        },
        recurse => {
            schema => 'bool*',
            cmdline_aliases => {r=>{}},
        },
        recurse_matching => {
            schema => ['str*', in=>['level-by-level', 'all-at-once']],
            default => 'level-by-level',
        },
        exclude_leaf => {
            schema => 'bool*',
        },
        exclude_dir => {
            schema => 'bool*',
        },
    },
    args_rels => {
        choose_one => [qw/ns_prefix ns_prefixes/],
    },
    result_naked => 1,
};
sub complete_module {
    require Complete::Path;

    my %args = @_;

    my $word = $args{word} // '';
    #$log->tracef('[compmod] Entering complete_module(), word=<%s>', $word);
    #$log->tracef('[compmod] args=%s', \%args);

    # convenience: allow Foo/Bar.{pm,pod,pmc}
    $word =~ s/\.(pm|pmc|pod)\z//;

    # convenience (and compromise): if word doesn't contain :: we use the
    # "safer" separator /, but if already contains '::' we use '::'. (Can also
    # use '.' if user uses that.) Using "::" in bash means user needs to use
    # quote (' or ") to make completion behave as expected since : is by default
    # a word break character in bash/readline.
    my $sep = $args{path_sep};
    unless (defined $sep) {
        $sep = $word =~ /::/ ? '::' :
            $word =~ /\./ ? '.' : '/';
    }

    # find shortcut prefixes
    {
        my $tmp = lc $word;
        for (keys %$OPT_SHORTCUT_PREFIXES) {
            if ($tmp =~ /\A\Q$_\E(?:(\Q$sep\E).*|\z)/) {
                substr($word, 0, length($_) + length($1 // '')) =
                    $OPT_SHORTCUT_PREFIXES->{$_};
                last;
            }
        }
    }

    $word =~ s!(::|/|\.)!::!g;

    my $find_pm      = $args{find_pm}     // 1;
    my $find_pmc     = $args{find_pmc}    // 1;
    my $find_pod     = $args{find_pod}    // 1;
    my $find_prefix  = $args{find_prefix} // 1;

    my @ns_prefixes  = $args{ns_prefixes} ? @{$args{ns_prefixes}} : ($args{ns_prefix});
    my $res = [];
    for my $ns_prefix (@ns_prefixes) {
        $ns_prefix //= '';
        $ns_prefix =~ s/(::)+\z//;

        #$log->tracef('[compmod] invoking complete_path, word=<%s>', $word);
        my $cp_res = Complete::Path::complete_path(
            word => $word,
            starting_path => $ns_prefix,
            list_func => sub {
                my ($path, $intdir, $isint) = @_;
                (my $fspath = $path) =~ s!::!/!g;
                my @res;
                for my $inc (@INC) {
                    next if ref($inc);
                    my $dir = $inc . (length($fspath) ? "/$fspath" : "");
                    opendir my($dh), $dir or next;
                    for (readdir $dh) {
                        next if $_ eq '.' || $_ eq '..';
                        next unless /\A\w+(\.\w+)?\z/;
                        my $is_dir = (-d "$dir/$_");
                        next if $isint && !$is_dir;
                        push @res, "$_\::" if $is_dir && ($isint || $find_prefix);
                        push @res, $1 if /(.+)\.pm\z/  && $find_pm;
                        push @res, $1 if /(.+)\.pmc\z/ && $find_pmc;
                        push @res, $1 if /(.+)\.pod\z/ && $find_pod;
                    }
                }
                [sort(uniq(@res))];
            },
            path_sep => '::',
            is_dir_func => sub { }, # not needed, we already suffix "dirs" with ::
            recurse => $args{recurse},
            recurse_matching => $args{recurse_matching},
            exclude_leaf => $args{exclude_leaf},
            exclude_dir  => $args{exclude_dir},
        );
        push @$res, @$cp_res;
    } # for $ns_prefix

    # dedup
    {
        last unless @ns_prefixes > 1;
        my $res_dedup = [];
        my %seen;
        for (@$res) { push @$res_dedup, $_ unless $seen{$_}++ }
        $res = $res_dedup;
    }

    for (@$res) { s/::/$sep/g }

    $res = { words=>$res, path_sep=>$sep };
    #$log->tracef('[compmod] Leaving complete_module(), result=<%s>', $res);
    $res;
}

1;
# ABSTRACT: Complete with installed Perl module names

__END__