File Coverage

blib/lib/App/DuckPAN/Query.pm
Criterion Covered Total %
statement 21 75 28.0
branch 0 10 0.0
condition n/a
subroutine 7 16 43.7
pod 0 1 0.0
total 28 102 27.4


line stmt bran cond sub pod time code
1             package App::DuckPAN::Query;
2             our $AUTHORITY = 'cpan:DDG';
3             # ABSTRACT: Main application/loop for duckpan query
4             $App::DuckPAN::Query::VERSION = '1017';
5 1     1   1141 use Moo;
  1         2  
  1         6  
6 1     1   208 use Data::Printer return_value => 'dump';
  1         2  
  1         7  
7 1     1   1304 use POE qw( Wheel::ReadLine );
  1         7435  
  1         4  
8 1     1   78719 use Try::Tiny;
  1         2  
  1         65  
9 1     1   4 use Path::Tiny;
  1         1  
  1         38  
10 1     1   13 use App::DuckPAN::Fathead;
  1         2  
  1         29  
11 1     1   4 use open qw/:std :utf8/;
  1         1  
  1         12  
12              
13             # Entry into the module.
14             sub run {
15 0     0 0   my ( $self, $app, $blocks ) = @_;
16              
17             # Here so that travis builds will pass on github
18 0           require DDG::Request;
19 0           DDG::Request->import;
20 0           require DDG::Test::Location;
21 0           DDG::Test::Location->import;
22 0           require DDG::Test::Language;
23 0           DDG::Test::Language->import;
24              
25             # Main session. All events declared have equivalent subs.
26 0           POE::Session->create(
27             package_states => [
28             $self => [qw(_start _stop _get_user_input _got_user_input _run_query)]
29             ],
30             args => [$app, $blocks] # passed to _start
31             );
32 0           POE::Kernel->run();
33              
34 0           return 0;
35             }
36              
37             # Initialize the main session. Called once by default.
38             sub _start {
39 0     0     my ($k, $h, $app, $blocks) = @_[KERNEL, HEAP, ARG0, ARG1];
40              
41 0           my $history_path = $app->cfg->cache_path->child('query_history');
42              
43             # Session that handles user input
44 0           my $powh_readline = POE::Wheel::ReadLine->new(
45             InputEvent => '_got_user_input'
46             );
47 0           $powh_readline->bind_key("C-\\", "interrupt");
48 0           $powh_readline->read_history($history_path);
49 0           $powh_readline->put('(Empty query for ending test)');
50              
51             # Store in the heap for use in other events
52 0           @$h{qw(app blocks console history_path)} = ($app, $blocks, $powh_readline, $history_path);
53              
54 0           $k->sig(TERM => '_stop');
55             # Queue user input event
56 0           $k->yield('_get_user_input');
57             }
58              
59 0     0     sub _default { warn "Unhandled event - $_[ARG0]" }
60              
61             # The session is about to stop. Ensure that the ReadLine object is
62             # deleted, so it can place your terminal back into a sane mode. This
63             # function is triggered by POE's "_stop" event.
64             sub _stop {
65 0     0     undef $_[HEAP]->{console}; #powh_readline;
66 0           exit;
67             }
68              
69             # Event to handle user input, triggered by ReadLine
70             sub _got_user_input {
71 0     0     my ($k, $h, $input) = @_[KERNEL, HEAP, ARG0];
72              
73             # If we have input, send it off to be processed
74 0 0         if($input){
75 0           my ($console, $history_path) = @$h{qw(console history_path)};
76              
77 0           $console->put(" You entered: $input");
78 0           $console->addhistory($input);
79 0           $console->write_history($history_path);
80 0           $k->yield(_run_query => $input); # this yield keeps the loop going
81             }
82             else{
83 0           $h->{console}->put('\\_o< Thanks for testing!');
84             }
85             # falling through here without queuing an event ends the app.
86             }
87              
88             # Event that prints the prompt and waits for input.
89             sub _get_user_input {
90 0     0     $_[HEAP]{console}->get('Query: ');
91             }
92              
93             # Event that processes the query
94             sub _run_query {
95 0     0     my ($k, $h, $query) = @_[KERNEL, HEAP, ARG0];
96              
97 0           my ($app, $blocks) = @$h{qw{app blocks}};
98 0           Encode::_utf8_on($query);
99              
100 0           my $repo = $app->get_ia_type;
101              
102             try {
103 0 0   0     if ($repo->{name} eq "Fathead") {
104 0           my $output_txt = $app->fathead->output_txt;
105 0 0         if (my $result = $app->fathead->structured_answer_for_query($query)) {
106 0           $app->emit_info('---', "Match found: $output_txt", p($result, colored => $app->colors), '---');
107             }
108             else {
109 0           $app->emit_error('Sorry, no matches found in output.txt');
110             }
111             }
112             else {
113 0           my $request = DDG::Request->new(
114             query_raw => $query,
115             location => test_location_by_env(),
116             language => test_language_by_env(),
117             );
118 0           my $hit;
119             # Iterate through the IAs passing each the query request
120 0           for my $b (@$blocks) {
121 0           for ($b->request($request)) {
122 0           $hit = 1;
123 0           $app->emit_info('---', p($_, colored => $app->colors), '---');
124             }
125             }
126 0 0         unless ($hit) {
127 0           $app->emit_info('Sorry, no Instant Answers returned a result')
128             }
129             }
130             }
131             catch {
132 0     0     my $error = $_;
133 0 0         if ($error =~ m/Malformed UTF-8 character/) {
134 0           $app->emit_info('You got a malformed utf8 error message. Normally' .
135             ' it means that you tried to enter a special character at the query' .
136             ' prompt but your interface is not properly configured for utf8.' .
137             ' Please check the documentation for your terminal, ssh client' .
138             ' or other client used to execute duckpan.'
139             );
140             }
141 0           $app->emit_info("Caught error: $error");
142 0           };
143              
144             # Enqueue input event
145 0           $k->yield('_get_user_input');
146             }
147              
148             1;
149              
150             __END__
151              
152             =pod
153              
154             =head1 NAME
155              
156             App::DuckPAN::Query - Main application/loop for duckpan query
157              
158             =head1 VERSION
159              
160             version 1017
161              
162             =head1 AUTHOR
163              
164             DuckDuckGo <open@duckduckgo.com>, Zach Thompson <zach@duckduckgo.com>, Zaahir Moolla <moollaza@duckduckgo.com>, Torsten Raudssus <torsten@raudss.us> L<https://raudss.us/>
165              
166             =head1 COPYRIGHT AND LICENSE
167              
168             This software is Copyright (c) 2013 by DuckDuckGo, Inc. L<https://duckduckgo.com/>.
169              
170             This is free software, licensed under:
171              
172             The Apache License, Version 2.0, January 2004
173              
174             =cut