view release on metacpan or  search on metacpan

lib/App/orgadb/Select/Shell.pm  view on Meta::CPAN

package App::orgadb::Select::Shell;

use 5.010001;
use strict 'subs', 'vars';
use warnings;
use Log::ger;

use parent qw(Term::Shell);

use Time::HiRes qw(time);

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2025-06-19'; # DATE
our $DIST = 'App-orgadb'; # DIST
our $VERSION = '0.020'; # VERSION

sub new {
    my ($class, %args) = @_;

    $class->_install_cmds;

    my $self = $class->SUPER::new();
    $self->{program_name} = $args{program_name} // 'orgadb-sel';

    $self->load_history;

    # TODO: override some settings from env, if available
    $self->load_settings;
    $self->{_settings}{output_format} //= 'text';

    $self->{_in_completion} = 0;

    $self->{_state}{main_args} = $args{main_args};

    $self;
}

# override, readline workarounds. TODO: extract routine. this is shared with
# App::riap.
sub cmdloop {
    require Carp;
    require IO::Stty;
    require Signal::Safety;

    my $o = shift;
    my $rl = $o->{term};

    local $SIG{INT} = sub {
        # save history when we are interrupted
        $o->save_history;
        print STDERR "Interrupted\n";
        if ($rl->ReadLine eq 'Term::ReadLine::Gnu') {
            IO::Stty::stty(\*STDIN, 'echo');
        }
        exit 1;
    };

    local $SIG{__DIE__} = sub {
        IO::Stty::stty(\*STDIN, 'echo');
        $o->setting('debug_stack_trace') ? Carp::confess(@_) : die(@_);
    };

    local $SIG{__WARN__} = sub {
        IO::Stty::stty(\*STDIN, 'echo');
        $o->setting('debug_stack_trace') ? Carp::cluck(@_) : warn(@_);
    };

    # some workaround for Term::ReadLine
    # say "D0, rl=", $rl->ReadLine;
    my $attribs = $rl->Attribs;
    if ($rl->ReadLine eq 'Term::ReadLine::Gnu') {
        # TR::Gnu traps our INT handler
        # ref: http://www.perlmonks.org/?node_id=1003497
        $attribs->{catch_signals} = 0;
    } elsif ($rl->ReadLine eq 'Term::ReadLine::Perl') {
        # TR::Perl messes up colors
        # doesn't do anything?
        #$rl->ornaments(0);
        #$attribs->{term_set} = ["", "", "", ""];
    }

    $o->{stop} = 0;