view release on metacpan or  search on metacpan

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

}

sub _get {
    my $self = shift;
    if (REPOSITORY) {
        $self->_local_get(@_);
    } else {
        $self->_http_get(@_);
    }
}

sub _http_get {
    my ($self, $query, $platform) = @_;
    my $url = sprintf $URL, $self->{language}, $platform, $query;
    my $res = $self->{http}->get($url);
    if ($res->{success}) {
        (Encode::decode_utf8($res->{content}), undef);
    } else {
        my $err = "$res->{status} $res->{reason}";
        if ($res->{status} == 599) {
            $err .= ", $res->{content}";
        }
        (undef, "$url: $err");
    }
}

sub _local_get {
    my ($self, $query, $platform) = @_;
    my $file = File::Spec->catfile(REPOSITORY, "pages$self->{language}", $platform, "$query.md");
    if (-f $file) {
        open my $fh, "<:utf8", $file or die "$file: $!";
        local $/;
        (<$fh>, undef);
    } else {
        (undef, "Missing $file");
    }
}

sub run {
    my $self = shift;
    my $arg  = shift @{$self->{argv}} or die $self->_help(1);
    my $content;
    for my $platform (@{ $self->{platform} }) {
        ($content, my $err) = $self->_get($arg, $platform);
        if ($content) {
            last;
        } elsif (DEBUG) {
            warn "-> $err\n";
        }
    }
    die "Couldn't find tldr for '$arg'\n" unless $content;
    $self->_render($content, $arg);
}

my $CHECK = "\N{U+2713}";
my $SUSHI = "\N{U+1F363}";

sub _render {
    my ($self, $content, $query) = @_;

    my ($check, $prompt) = $self->{unicode} ? ($CHECK, $SUSHI) : ('*', '$');

    my $width = $ENV{COLUMNS} || (Term::ReadKey::GetTerminalSize())[0];
    $width -= 4;

    my @line = split /\n/, $content;

    my $out;
    if ($self->{pager}) {
        open $out, "|-", @{$self->{pager}} or die "failed to exec @{$self->{pager}}: $!";
    } else {
        $out = \*STDOUT;
    }
    binmode $out, ":utf8";

    while (defined(my $line = shift @line)) {
        if ($line =~ /^#/) {
            # skip
        } elsif ($line =~ s/^\>\s*//) {
            my $description = $line;
            while (1) {
                my $next = shift @line;
                if ($next eq "") {
                    next;
                } elsif ($next =~ s/^\>\s*//) {
                    $description .= "\n$next";
                } else {
                    unshift @line, $next;
                    last;
                }
            }
            my $fold = Text::Fold::fold_text($description, $width);
            $out->print("\n");
            $out->print("  \e[32m$_\e[m\n") for split /\n/, $fold;
            $out->print("\n");
        } elsif ($line =~ s/^[*-]\s*//) {
            my $fold = Text::Fold::fold_text($line, $width - 2);
            my ($first, @rest) = split /\n/, $fold;
            $out->print("  \e[1m$check \e[4m$first\e[m\n");
            $out->print("    \e[1m\e[4m$_\e[m\n") for @rest;
            $out->print("\n");
        } elsif ($line =~ /`([^`]+)`/) {
            my $code = $1;
            $code =~ s/\b$query\b/
              "\e[32m$query\e[m"
            /eg;
            $out->print("    $prompt $code\n\n");
        }
    }
}

1;
__END__

=encoding utf-8

=head1 NAME

App::tldr - a perl client for https://tldr.sh/

=head1 SYNOPSIS

  $ tldr tar

=head1 DESCRIPTION

App::tldr is a client for L<https://tldr.sh/>.

=head1 SEE ALSO

L<https://github.com/tldr-pages/tldr>

=head1 COPYRIGHT AND LICENSE

Copyright 2016 Shoichi Kaji <skaji@cpan.org>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut