]> iEval git - app-zealc.git/blame - lib/App/Zealc/Command/query.pm
Initial commit
[app-zealc.git] / lib / App / Zealc / Command / query.pm
CommitLineData
6c01e3e3
MG
1package App::Zealc::Command::query;
2
3use 5.014000;
4use strict;
5use warnings;
6
7our $VERSION = '0.000_001';
8
9use App::Zealc '-command';
10
11use IO::Prompter;
12use File::Slurp qw/write_file/;
13use File::Temp qw//;
14use File::Which;
15use HTML::FormatText;
16use Term::Pager;
17
18use Encode qw/encode/;
19
20# These set --format=html and --with=something
21use constant BROWSERS => [ qw/www-browser lynx links2 elinks w3m x-www-browser firefox/ ];
22my @BROWSERS = map { [$_, "Shorthand for --format=html --with=$_", {implies => {with => $_, format => 'html'}}] } @{BROWSERS()};
23
24# These set -format=something
25use 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];
30my @FORMATTERS = map {
31 my ($name, $format) = @$_;
32 [$name, "Shorthand for --format='$format'", {implies => {format => $format}}]
33} @{FORMATTERS()};
34
35# These set --with=something
36use constant PAGERS => [ qw/pager less most more pg/ ];
37my @PAGERS = map { [$_, "Shorthand for --with=$_", {implies => {with => $_}}] } @{PAGERS()};
38
39sub 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
48sub usage_desc { "%c query %o term" };
49
50sub 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
98sub 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
108sub 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
130sub 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
1551;
156__END__
157
158=encoding utf-8
159
160=head1 NAME
161
162App::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
174The query command displays the documentation for a given term. The
175term is a SQL LIKE pattern. If no documents are found, the search is
176retried after appending a % to the term. If multiple documents are
177found, the user will be prompted to choose one of them.
178
179A SQL LIKE pattern is similar to a shell glob. The "%" character
180matches zero or more characters (like "*" in a shell glob or ".*" in a
181regex) and "_" matches exactly one character (like "?" in a shell glob
182or "." in a regex). Matching is case-insensitive.
183
184=head1 SEE ALSO
185
186L<zealc>, L<Zeal>
187
188=head1 AUTHOR
189
190Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
191
192=head1 COPYRIGHT AND LICENSE
193
194Copyright (C) 2015 by Marius Gavrilescu
195
196This library is free software; you can redistribute it and/or modify
197it under the same terms as Perl itself, either Perl version 5.20.1 or,
198at your option, any later version of Perl 5 you may have available.
199
200
201=cut
This page took 0.044166 seconds and 4 git commands to generate.