view release on metacpan or  search on metacpan

lib/App/shcompgen.pm  view on Meta::CPAN

                "func.completer_command" => $prog,
                "func.completee" => $completee,
                "func.note"=>"hint(completer)",
                %extrametas,
            }];
        }

        if ($is_perl_script) {
            for my $line (@lines) {
                if ($line =~ /^\s*\# PERICMD_INLINE_SCRIPT: /) {
                    # pericmd-inline script cannot complete themselves, but they
                    # usually come with a separate completer script
                    return [200, "OK", 0, {
                        "func.reason" => "Perinci::CmdLine::Inline script",
                    }];
                }
            }

            for my $line (@lines) {
                if ($line =~ /^\s*((?:use|require)\s+
                                  (
                                      Getopt::Std|
                                      Getopt::Long(?:::Complete|::Less|::EvenLess|::Subcommand|::More|::Descriptive)?|
                                      CLI::MetaUtil::Getopt::Long(?::Complete)?|
                                      Perinci::CmdLine(?:::Any|::Lite|::Classic)
                              ))\b/x) {
                    return [200, "OK", 1, {
                        "func.completer_command"=> $prog, # later will be set
                        "func.completer_type"=> $2,
                        "func.note"=>"perl use/require statement: $1",
                    }];
                }
            }
        }
    }
    [200, "OK", 0];
}

sub _generate_or_remove {
    my $which0 = shift;
    my %args = @_;

    my $setdef_res = _set_args_defaults(\%args);
    return $setdef_res unless $setdef_res->[0] == 200;

    # to avoid writing a file and then removing the file again in the same run
    my %written_files;

    my %removed_files;

    my $envres = envresmulti();
  PROG:
    for my $prog0 (@{ $args{prog} }) {
        my ($prog, $progpath);
        log_debug("Processing program %s ...", $prog0);
        if ($prog0 =~ m!/!) {
            ($prog = $prog0) =~ s!.+/!!;
            $progpath = $prog0;
            unless (-f $progpath) {
                log_error("No such file %s, skipped", $progpath);
                $envres->add_result(404, "No such file", {item_id=>$prog0});
                next PROG;
            }
        } else {
            require File::Which;
            $prog = $prog0;
            $progpath = File::Which::which($prog0);
            unless ($progpath) {
                log_error("'%s' not found in PATH, skipped", $prog0);
                $envres->add_result(404, "Not in PATH", {item_id=>$prog0});
                next PROG;
            }
        }

        my $which = $which0;
        if ($which eq 'generate') {
            my $detres = _detect_prog(prog=>$prog, progpath=>$progpath, shell=>$args{shell});
            if ($detres->[0] != 200) {
                log_error("Can't detect '%s': %s", $prog, $detres->[1]);
                $envres->add_result($detres->[0], $detres->[1],
                                    {item_id=>$prog0});
                next PROG;
            }
            log_debug("Detection result for '%s': %s", $prog, $detres);
            if (!$detres->[2]) {
                if ($args{remove}) {
                    $which = 'remove';
                    goto REMOVE;
                } else {
                    next PROG;
                }
            }

            my ($script, @helper_scripts) = _gen_completion_script(
                %args, prog => $prog, progpath => $progpath, detect_res => $detres);
            my $comppath = _completion_script_path(
                %args, prog => $prog, detect_res => $detres);

            if ($args{stdout}) {
                print $script;
                next PROG;
            }

            if (-f $comppath) {
                if (!$args{replace}) {
                    log_info("Not replacing completion script for $prog in '$comppath' (use --replace to replace)");
                    $envres->add_result(304, "Not replaced (already exists)", {item_id=>$prog0});
                    next PROG;
                }
            }
            log_info("Writing completion script to %s ...", $comppath);
            $written_files{$comppath}++;
            eval { write_text($comppath, $script) };
            if ($@) {
                $envres->add_result(500, "Can't write to '$comppath': $@",
                                    {item_id=>$prog0});
                next PROG;
            }
            for my $hs (@helper_scripts) {
                log_info("Writing helper script %s ...", $hs->{path});
                $written_files{$hs->{path}}++;
                eval {
                    write_text($hs->{path}, $hs->{content});
                    chmod 0755, $hs->{path};
                };
                if ($@) {
                    $envres->add_result(500, "Can't write helper script to '$hs->{path}': $@",
                                        {item_id=>$prog0});
                    next PROG;
                }

lib/App/shcompgen.pm  view on Meta::CPAN

                }
                $removed_files{$hspath}++;
            }
            $envres->add_result(200, "OK", {item_id=>$prog0});
            $removed_files{$comppath}++;
        } # remove

    } # for prog0

    if (keys(%written_files) || keys(%removed_files)) {
        if ($args{shell} eq 'tcsh') {
            my $init_script_path = _tcsh_init_script_path(%args);
            my $init_script = _gen_tcsh_init_script(%args);
            log_debug("Re-writing init script %s ...", $init_script_path);
            write_text($init_script_path, $init_script);
        }
    }

    $envres->as_struct;
}

$SPEC{guess_shell} = {
    v => 1.1,
    summary => 'Guess running shell',
    args => {
    },
};
sub guess_shell {
    my %args = @_;

    my $setdef_res = _set_args_defaults(\%args);
    return $setdef_res unless $setdef_res->[0] == 200;

    [200, "OK", $args{shell}];
}

$SPEC{detect_prog} = {
    v => 1.1,
    summary => "Detect a program",
    args => {
        %shell_arg,
        prog => {
            schema => 'str*',
            completion => $_complete_prog,
            req => 1,
            pos => 0,
        },
    },
    'cmdline.default_format' => 'json',
};
sub detect_prog {
    require File::Which;

    my %args = @_;

    _set_args_defaults(\%args);

    my $progname = $args{prog};
    my $progpath = File::Which::which($progname);

    return [404, "No such program '$progname'"] unless $progpath;
    $progname =~ s!.+/!!;

    _detect_prog(
        prog => $progname,
        progpath => $progpath,
        shell => $args{shell},
    );
}

$SPEC{init} = {
    v => 1.1,
    summary => 'Initialize shcompgen',
    description => <<'_',

This subcommand creates the completion directories and initialization shell
script, as well as run `generate`.

_
    args => {
        %common_args,
    },
};
sub init {
    my %args = @_;

    my $setdef_res = _set_args_defaults(\%args);
    return $setdef_res unless $setdef_res->[0] == 200;

    my $shell = $args{shell};
    my $global = $args{global};

    my $instruction = '';

    my $dirs;
    my $init_location;
    my $init_script;
    my $init_script_path;

    $dirs = _completion_scripts_dirs(%args);

    if ($global) {
        push @$dirs, $args{helper_global_dir};
    } else {
        push @$dirs, $args{helper_per_user_dir};
    }

    if ($shell eq 'bash') {
        $init_location = $global ?
            (-d "/etc/profile.d" ? "/etc/profile.d/shcompgen.sh" : "/etc/bash.bashrc") :
            "~/.bashrc";
        $init_script = <<_;
# generated by shcompgen version $App::shcompgen::VERSION
_
        $init_script .= <<'_';
_shcompgen_loader()
{
    # check if bash-completion is active by the existence of function
    # '_completion_loader'.
    local bc_active=0
    if [[ "`type -t _completion_loader`" = "function" ]]; then bc_active=1; fi