]>
Commit | Line | Data |
---|---|---|
6c01e3e3 MG |
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 |