| 1 | package App::Zealc::Command::query; |
| 2 | |
| 3 | use 5.014000; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | |
| 7 | our $VERSION = '0.000_001'; |
| 8 | |
| 9 | use App::Zealc '-command'; |
| 10 | |
| 11 | use IO::Prompter; |
| 12 | use File::Slurp qw/write_file/; |
| 13 | use File::Temp qw//; |
| 14 | use File::Which; |
| 15 | use HTML::FormatText; |
| 16 | use Term::Pager; |
| 17 | |
| 18 | use Encode qw/encode/; |
| 19 | |
| 20 | # These set --format=html and --with=something |
| 21 | use constant BROWSERS => [ qw/www-browser lynx links2 elinks w3m x-www-browser firefox/ ]; |
| 22 | my @BROWSERS = map { [$_, "Shorthand for --format=html --with=$_", {implies => {with => $_, format => 'html'}}] } @{BROWSERS()}; |
| 23 | |
| 24 | # These set -format=something |
| 25 | use constant FORMATTERS => [ |
| 26 | [lynxdump => 'lynx -dump -nolist'], |
| 27 | [links2dump => 'links2 -dump'], |
| 28 | [elinksdump => 'elinks -dump -eval "set document.dump.references = 0" -eval "set document.dump.numbering = 0"'], |
| 29 | ]; |
| 30 | my @FORMATTERS = map { |
| 31 | my ($name, $format) = @$_; |
| 32 | [$name, "Shorthand for --format='$format'", {implies => {format => $format}}] |
| 33 | } @{FORMATTERS()}; |
| 34 | |
| 35 | # These set --with=something |
| 36 | use constant PAGERS => [ qw/pager less most more pg/ ]; |
| 37 | my @PAGERS = map { [$_, "Shorthand for --with=$_", {implies => {with => $_}}] } @{PAGERS()}; |
| 38 | |
| 39 | sub opt_spec {( |
| 40 | ['with|w=s', 'Open with this program'], |
| 41 | ['format|f=s', 'Convert html to this format'], |
| 42 | |
| 43 | [], @BROWSERS, |
| 44 | [], @FORMATTERS, |
| 45 | [], @PAGERS, |
| 46 | )} |
| 47 | |
| 48 | sub usage_desc { "%c query %o term" }; |
| 49 | |
| 50 | sub validate_args { |
| 51 | my ($self, $opts, $args) = @_; |
| 52 | my @args = @$args; |
| 53 | $self->usage_error("No query specified") unless @args; |
| 54 | $self->usage_error("Too many arguments") if @args > 1; |
| 55 | $opts->{with} //= $self->app->config->{with}; |
| 56 | $opts->{format} //= $self->app->config->{format}; |
| 57 | |
| 58 | # If output is not a tty, do not choose browsers/pagers |
| 59 | $opts->{with} //= '' unless -t select; |
| 60 | |
| 61 | # Try to default to a browser |
| 62 | if (!defined $opts->{with} && !defined $opts->{format}) { |
| 63 | for my $browser (@{BROWSERS()}) { |
| 64 | warn "Trying to use $browser as a browser\n" if $self->app->verbose; |
| 65 | next unless which $browser; |
| 66 | $opts->{with} = $browser; |
| 67 | $opts->{format} = 'html'; |
| 68 | last |
| 69 | } |
| 70 | } |
| 71 | |
| 72 | # If no browsers were found, try to choose a formatter |
| 73 | unless (defined $opts->{format}) { |
| 74 | for my $formatter (map { $_->[1] } @{FORMATTERS()}) { |
| 75 | my ($exec) = $formatter =~ /^(\w+)/s; |
| 76 | warn "Trying to use $exec ($formatter) as a formatter\n" if $self->app->verbose; |
| 77 | next unless which $exec; |
| 78 | $opts->{format} = $formatter; |
| 79 | last |
| 80 | } |
| 81 | } |
| 82 | |
| 83 | # If no browsers were found, try to choose a pager |
| 84 | unless (defined $opts->{with}) { |
| 85 | for my $pager (@{PAGERS()}) { |
| 86 | warn "Trying to use $pager as a pager\n" if $self->app->verbose; |
| 87 | next unless which $pager; |
| 88 | $opts->{with} = $pager; |
| 89 | last |
| 90 | } |
| 91 | } |
| 92 | |
| 93 | # Default to HTML::FormatText and the internal pager |
| 94 | $opts->{format} //= 'text'; |
| 95 | $opts->{with} //= ''; |
| 96 | } |
| 97 | |
| 98 | sub html_to_format { |
| 99 | my ($html, $format) = @_; |
| 100 | return $html if $format eq 'html'; |
| 101 | return HTML::FormatText->format_string($html) if $format eq 'text'; |
| 102 | my $tmp = File::Temp->new(TEMPLATE => 'zealcXXXX', SUFFIX => '.html'); |
| 103 | write_file $tmp, $html; |
| 104 | my $fn = $tmp->filename; |
| 105 | `$format $fn` |
| 106 | } |
| 107 | |
| 108 | sub show_document { |
| 109 | my ($self, $doc, %opts) = @_; |
| 110 | my $html = $doc->fetch; |
| 111 | |
| 112 | say "Format: $opts{format}" if $self->app->verbose; |
| 113 | say "Open with: ", $opts{with} // 'internal pager' if $self->app->verbose;; |
| 114 | |
| 115 | my $text = encode 'UTF-8', html_to_format $html, $opts{format}; |
| 116 | |
| 117 | if ($opts{with}) { |
| 118 | my $tmp = File::Temp->new(TEMPLATE => 'zealcXXXX', SUFFIX => '.html'); |
| 119 | write_file $tmp, $text; |
| 120 | system $opts{with} . ' ' . $tmp->filename; |
| 121 | } elsif (!-t select) { |
| 122 | say $text |
| 123 | } else { |
| 124 | my ($rows, $cols) = split ' ', `stty size`; |
| 125 | my $pager = Term::Pager->new(text => $text, rows => $rows, cols => $cols); |
| 126 | $pager->more; |
| 127 | } |
| 128 | } |
| 129 | |
| 130 | sub execute { |
| 131 | my ($self, $opts, $args) = @_; |
| 132 | my %opts = %$opts; |
| 133 | my ($query) = @$args; |
| 134 | my $zeal = $self->app->zeal; |
| 135 | my @results = $zeal->query($query); |
| 136 | @results = $zeal->query("$query%") unless @results; |
| 137 | die "No results found for $query\n" unless @results; |
| 138 | |
| 139 | my $doc = $results[0]; |
| 140 | if (@results > 1 && -t select) { |
| 141 | my @args = '-single'; |
| 142 | @args = '-number' if @results > 52; |
| 143 | my %menu = map { |
| 144 | my $ds = $results[$_]->docset->name; |
| 145 | $results[$_]->name . " ($ds)" => $_ |
| 146 | } 0 .. $#results; |
| 147 | $doc = prompt 'Choose a document', -menu => \%menu, '-stdio', @args; |
| 148 | return unless $doc; |
| 149 | $doc = $results[$doc]; |
| 150 | } |
| 151 | |
| 152 | $self->show_document($doc, %opts); |
| 153 | } |
| 154 | |
| 155 | 1; |
| 156 | __END__ |
| 157 | |
| 158 | =encoding utf-8 |
| 159 | |
| 160 | =head1 NAME |
| 161 | |
| 162 | App::Zealc::Command::query - view the documentation for a term |
| 163 | |
| 164 | =head1 SYNOPSIS |
| 165 | |
| 166 | zealc query perldoc |
| 167 | # displays documentation for perldoc |
| 168 | |
| 169 | zealc query --w3m perl:%Spec |
| 170 | # finds File::Spec and perlpodspec |
| 171 | |
| 172 | =head1 DESCRIPTION |
| 173 | |
| 174 | The query command displays the documentation for a given term. The |
| 175 | term is a SQL LIKE pattern. If no documents are found, the search is |
| 176 | retried after appending a % to the term. If multiple documents are |
| 177 | found, the user will be prompted to choose one of them. |
| 178 | |
| 179 | A SQL LIKE pattern is similar to a shell glob. The "%" character |
| 180 | matches zero or more characters (like "*" in a shell glob or ".*" in a |
| 181 | regex) and "_" matches exactly one character (like "?" in a shell glob |
| 182 | or "." in a regex). Matching is case-insensitive. |
| 183 | |
| 184 | =head1 SEE ALSO |
| 185 | |
| 186 | L<zealc>, L<Zeal> |
| 187 | |
| 188 | =head1 AUTHOR |
| 189 | |
| 190 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 191 | |
| 192 | =head1 COPYRIGHT AND LICENSE |
| 193 | |
| 194 | Copyright (C) 2015 by Marius Gavrilescu |
| 195 | |
| 196 | This library is free software; you can redistribute it and/or modify |
| 197 | it under the same terms as Perl itself, either Perl version 5.20.1 or, |
| 198 | at your option, any later version of Perl 5 you may have available. |
| 199 | |
| 200 | |
| 201 | =cut |