view release on metacpan or  search on metacpan

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

    my $res = $self->riap_parse_url($surl);
    die "Can't parse url $surl\n" unless $res;
    $pwd = $res->{path};
    $self->state(pwd        => $pwd);
    $self->state(start_pwd  => $pwd);
    $self->run_cd($pwd);

    $self;
}

# override, readline workarounds
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;
    $o->preloop;
    while (1) {
        my $line;
        {
            no warnings 'once';
            local $Signal::Safety = 0; # limit the use of unsafe signals
            $line = $o->readline($o->prompt_str);
        }
        last unless defined($line);
        my $time1 = time();
        $o->cmd($line);
        my $time2 = time();
        if ($o->setting('debug_time_command')) {
            say sprintf("  %.3fs", ($time2-$time1));
        }
        last if $o->{stop};
    }
    $o->postloop;
}

sub mainloop { goto \&cmdloop }

sub colorize {
    my ($self, $text, $color) = @_;
    if ($self->{use_color}) {
        ansifg($color) . $text . "\e[0m";
    } else {
        $text;
    }
}

sub _json_obj {
    state $json;
    if (!$json) {
        require JSON::MaybeXS;
        $json = JSON::MaybeXS->new->allow_nonref;
    }
    $json;
}

sub json_decode {
    my ($self, $arg) = @_;
    $self->_json_obj->decode($arg);
}

sub json_encode {
    my ($self, $arg) = @_;
    my $data = $cleanser->clone_and_clean($arg);
    #use Data::Dump; dd $data;
    $self->_json_obj->encode($data);
}

sub settings_filename {
    my $self = shift;
    $ENV{RIAPRC} // "$ENV{HOME}/.riaprc";
}

sub history_filename {
    my $self = shift;
    $ENV{RIAP_HISTFILE} // "$ENV{HOME}/.riap_history";
}

sub known_settings {
    state $settings;
    if (!$settings) {
        require Perinci::Result::Format;
        $settings = {

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

        my $res = Config::IOD::Reader->new->read_file($filename);
        last unless $res->{GLOBAL};
        for (sort keys %{$res->{GLOBAL}}) {
            $self->setting($_, $res->{GLOBAL}{$_});
        }
    }
}

sub save_settings {
    die "Unimplemented";
}

sub clear_history {
    my $self = shift;

    if ($self->{term}->Features->{setHistory}) {
        $self->{term}->SetHistory();
    }
}

sub load_history {
    my $self = shift;

    if ($self->{term}->Features->{setHistory}) {
        my $filename = $self->history_filename;
        return unless $filename;
        if (-r $filename) {
            log_trace("Loading history from %s ...", $filename);
            open(my $fh, '<', $filename)
                or die "Can't open history file $filename: $!\n";
            chomp(my @history = <$fh>);
            $self->{term}->SetHistory(@history);
            close $fh or die "Can't close history file $filename: $!\n";
        }
    }
}

sub save_history {
    my $self = shift;

    if ($self->{term}->Features->{getHistory}) {
        my $filename = $self->history_filename;
        unless ($filename) {
            log_warn("Skipped saving history since filename not defined");
            return;
        }
        log_trace("Saving history to %s ...", $filename);
        open(my $fh, '>', $filename)
            or die "Can't open history file $filename for writing: $!\n";
        print $fh "$_\n" for grep { length } $self->{term}->GetHistory;
        close $fh or die "Can't close history file $filename: $!\n";
    }
}

sub postloop {
    my $self = shift;
    print "\n";
    $self->save_history;
}

sub prompt_str {
    my $self = shift;
    join(
        "",
        $self->colorize("riap", "4169e1"), " ", # royal blue
        $self->colorize($self->state("pwd"), "2e8b57"), " ", # seagreen
        "> ",
    );
}

sub _riap_set_copts {
    my $self = shift;
    return {
        user     => $self->setting('user'),
        password => $self->setting('password'),
    };
}

sub riap_parse_url {
    my ($self, $url) = @_;
    my $copts = $self->_riap_set_copts;
    $self->{_pa}->parse_url($url, $copts);
}

sub riap_request {
    my ($self, $action, $uri, $extra0) = @_;
    my $copts = $self->_riap_set_copts;

    my $surl = $self->state('server_url');

    my $extra = { %{ $extra0 // {} } };
    $extra->{uri} = $uri;

    my $show = $self->{_in_completion} ?
        $self->setting("debug_riap") && $self->setting("debug_completion") :
            $self->setting("debug_riap");

    if ($show) {
        say "DEBUG: Riap request: $action => $surl ".
            $self->json_encode($extra);
    }
    my $res;
    my $cache_key = $self->json_encode({action=>$action, %$extra});
    # we only want to cache some actions
    if ($action =~ /\A(info|list|meta|child_metas)\z/ &&
            ($res = $self->{_cache}->get($cache_key))) {
        # cache hit
        if ($show) {
            say "DEBUG: Riap response (from cache): $action => $surl ".
                $res;
        }
        $res = $self->json_decode($res);
    } else {
        # cache miss, get from server
        $res  = $self->{_pa}->request($action, $surl, $extra, $copts);
        if ($show) {
            say "DEBUG: Riap response: ".$self->json_encode($res);
        }
        if ($self->setting('cache_period')) {
            $self->{_cache}->set($cache_key, $self->json_encode($res),
                                 $self->setting('cache_period')." s");