view release on metacpan or  search on metacpan

lib/App/ShellCompleter/cpanm.pm  view on Meta::CPAN

use Complete::Util qw(answer_has_entries complete_array_elem);
use Getopt::Long::Complete qw(GetOptionsWithCompletion);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2023-07-08'; # DATE
our $DIST = 'App-ShellCompleter-cpanm'; # DIST
our $VERSION = '0.212'; # VERSION

my $noop = sub {};

# complete with list of installed modules
my $comp_installed_mods = sub {
    require Complete::Module;

    my %args = @_;

    log_trace("[_cpanm] Adding completion: installed modules");
    Complete::Module::complete_module(
        word => $args{word},
        path_sep => '::',
    );
};

# complete with installable stuff
my $comp_installable = sub {
    my %args = @_;
    my $word   = $args{word} // '';

    # try completing script name if we are in SCRIPT_MODE
    {
        last unless $ENV{SCRIPT_MODE};
        last unless $word eq '' || $word =~ /\A\w[\w-]*\z/;

        my $dbh = _connect_lcpan() or last;

        my $sth;
        $sth = $dbh->prepare(
            "SELECT name FROM script WHERE name LIKE '$word%' ORDER BY name");
        $sth->execute;
        my @scripts;
        my %seen;
        while (my @row = $sth->fetchrow_array) {
            my $script = $row[0];
            push @scripts, $script unless $seen{$script}++;
        }
        return \@scripts if @scripts;
    }

    # first, we try the cheapest method first, which is local files
    {
        log_trace("[_cpanm] Trying completion: tarballs & dirs");
        local $Complete::Common::OPT_FUZZY = 0;
        local $Complete::Common::OPT_WORD_MODE = 0;
        local $Complete::Common::OPT_CHAR_MODE = 0;
        my $answer = complete_file(
            filter => sub { log_trace("  $_"); /\.(zip|tar\.gz|tar\.bz2)$/i || (-d $_) },
            word   => $word,
        );
    }

    # if that fails, and the word looks like the start of module name, try
    # searching for CPAN module. currently we only query local CPAN for speed.

    # if user already types something that looks like a path instead of module
    # name, like '../' or perhaps 'C:\' (windows) then don't bother to complete
    # with module name because it will just delay things without getting any
    # result.
    {
        last unless $word eq '' || $word =~ /\A(\w+)(::\w+)*(::)?\z/;
        use experimental 'smartmatch';

        my $dbh = _connect_lcpan() or last;

        my $sth;
        my $mod_prefix = $args{mod_prefix} // '';
        my $prefixed_word = "$mod_prefix$word";
        my $num_sep = 0; while ($prefixed_word =~ /::/g) { $num_sep++ }
        if ($prefixed_word eq '') {
            $sth = $dbh->prepare("SELECT name,has_child FROM namespace WHERE name='' AND num_sep=0 ORDER BY name");
        } else {
            $sth = $dbh->prepare("SELECT name,has_child FROM namespace WHERE name LIKE '$prefixed_word%' AND num_sep=$num_sep ORDER BY name");
        }
        $sth->execute;
        my @mods;
        while (my @row = $sth->fetchrow_array) {
            my $mod = $row[0];
            $mod =~ s/\A\Q$mod_prefix\E//;
            push @mods, $mod unless grep { $_ eq $mod } @mods;
            if ($row[1]) {
                $mod .= '::';
                push @mods, $mod unless grep { $_ eq $mod } @mods;
            }
        };
        return \@mods if @mods;
    }

    # TODO module name can be suffixed with '@<version>'

    [];
};

sub _connect_lcpan {
    no warnings 'once';

    eval "use App::lcpan 0.32"; ## no critic: TestingAndDebugging::ProhibitNoStrict
    if ($@) {
        log_trace("[_cpanm] App::lcpan not available, skipped ".
                         "trying to complete from CPAN module names");
        return;
    }

    require Perinci::CmdLine::Util::Config;

    my %lcpanargs;
    my $res = Perinci::CmdLine::Util::Config::read_config(
        program_name => "lcpan",
    );
    unless ($res->[0] == 200) {
        log_trace("[_cpanm] Can't get config for lcpan: %s", $res);
        last;
    }
    my $config = $res->[2];

    $res = Perinci::CmdLine::Util::Config::get_args_from_config(