view release on metacpan or  search on metacpan

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

        } 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;
                }
            }
            $envres->add_result(200, "OK", {item_id=>$prog0});
        } # generate

      REMOVE:
        if ($which eq 'remove') {
            my $comppath = _completion_script_path(%args, prog => $prog);
            unless (-f $comppath) {
                log_debug("Skipping %s (completion script does not exist)", $prog0);
                $envres->add_result(304, "Completion does not exist", {item_id=>$prog0});
                next PROG;
            }
            my $content;
            eval { $content = read_text($comppath) };
            if ($@) {
                $envres->add_result(500, "Can't open '$comppath': $@", {item_id=>$prog0});
                next;
            };
            unless ($content =~ /^# FRAGMENT id=shcompgen-header note=(.+)\b/m) {
                log_debug("Skipping %s, not installed by us", $prog0);
                $envres->add_result(304, "Not installed by us", {item_id=>$prog0});
                next PROG;
            }
            if ($written_files{$comppath}) {
                # not removing files we already wrote
                next PROG;
            }
            log_info("Unlinking %s ...", $comppath);
            unless (unlink $comppath) {
                $envres->add_result(500, "Can't unlink '$comppath': $!",
                                    {item_id=>$prog0});
                next PROG;
            }
            # XXX we should only remove helper script if there are no other
            # shells' completion scripts using this
            while ($content =~ /^# FRAGMENT id=shcompgen-helper-\d+ path=(.+)/mg) {
                my $hspath = $1;
                log_info("Unlinking helper script %s ...", $1);
                unless (unlink $hspath) {
                    $envres->add_result(500, "Can't unlink helper script '$hspath': $!",
                                        {item_id=>$prog0});
                    next PROG;
                }
                $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);