view release on metacpan or  search on metacpan

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

    my($self) = @_;
    say "Running: " .
        String::ShellQuote::shell_quote_best_effort(@{$self->_cmd})
        if $self->verbose;

    Term::ReadKey::ReadMode("noecho");
    END { Term::ReadKey::ReadMode("normal"); }

    $self->_term(Term::ReadLine->new("prolix"));
    my $attribs = $self->_term->Attribs;
    $attribs->{completion_entry_function} =
        $attribs->{list_completion_function};
    $attribs->{completion_word} = [qw(
        help
        ignore_line
        ignore_re
        ignore_substring
        pats
        quit
        snippet
        stats
    )];

    my $t = IPC::Run::timer(0.3);
    my $ipc = IPC::Run::start $self->_cmd,
        \undef,  # no stdin
        $self->_out,
        $self->_err,
        $t;
    $t->start;
    my $pumping = 1;
    while ($pumping && $ipc->pump) {
        $self->consume;
        try {
            $self->try_user_input;
        } catch {
            when (/prolix-quit/) {
                $ipc->kill_kill;
                $pumping = 0;
            }
            default { die $_ }
        };
        $t->start(0.3);
    }
    $t->reset;
    $ipc->finish;
    $self->consume_final;

    Term::ReadKey::ReadMode("normal");
}

sub _dump_stack {
    print Carp::longmess("************");
    $SIG{USR1} = \&_dump_stack;
}

sub try_user_input {
    my($self) = @_;
    return if not defined Term::ReadKey::ReadKey(-1);

    # Enter interactive prompt mode. We hope this will be brief, and
    # IPC::Run can buffer our watched command in the meanhwile.

	say q{Press ENTER to go back, or enter "help" for a list of commands.}
		if $self->verbose;

    Term::ReadKey::ReadMode("normal");
    while (my $cmd = $self->_term->readline("prolix>")) {
        $self->_term->addhistory($cmd);
        $self->handle_user_input($cmd);
    }
    Term::ReadKey::ReadMode("restore");  # into noecho, we hope!
}

sub handle_user_input {
    my($self, $cmd) = @_;
    (my $nullary = $cmd) =~ s/^\s*(\S+)\s*/$1/;
    if ($nullary) {
        given ($nullary) {
            when ("clear_all") { $self->clear_all }
            when ("stack")     { _dump_stack }
            when ("bufs")      { $self->dump_bufs }
            when (/q|quit/)    { die "prolix-quit\n" }
            when (/h|help/)    { $self->help_interactive }
            when ("pats")      { $self->dump_pats }
            when ("stats")     { say $self->stats }
            default            { say q{Unknown command. Try "help".} }
        }
    } else {
        given ($cmd) {
            when (/^\s*(ignore_(?:line|re|substring))\s+(.*)/) {
                my($ignore_type, $pat) = ($1, $2);
                push @{ $self->$ignore_type }, $pat;
                $self->import_re($pat) if $ignore_type eq 're';
            }
            when (/^\s*snippet\s(.*)/) {
                push @{ $self->snippet }, $1;
                $self->import_snippet($1);
            }
            default { say q{Unknown command. Try "help".} }
        }
    }
}

sub import_re {
    my($self, $pat) = @_;

    push @{ $self->_ignore_re }, qr/$pat/;
}

sub import_snippet {
    my($self, $snippet) = @_;

    my $help = <<".";
*** Usage: snippet s/find_re/replace/

    You may use Perl-like quoting on the substitution operation, so if your
    pattern contains slashes use a different delimiter.

    Modifiers that are honored: /igx   (m and s aren't meaningful here)
.