/lib/App/DuckDuckGo/UI.pm

  1package App::DuckDuckGo::UI;
  2
  3use Moo;
  4
  5our $VERSION = 'devel';
  6
  7use Curses;
  8use Curses::UI::POE;
  9use Curses::UI::TextEditor;
 10use WWW::DuckDuckGo;
 11use URI::Encode qw/uri_decode uri_encode/;
 12use JSON;
 13use POE 'Component::Client::HTTP';
 14use HTTP::Request;
 15
 16use App::DuckDuckGo::UI::Config;
 17
 18has config => (
 19    is => 'ro',
 20    default => sub { App::DuckDuckGo::UI::Config->new },
 21);
 22
 23has ui => (
 24    is => 'ro',
 25    default => sub {
 26        my $self = shift;
 27        Curses::UI::POE->new(
 28            -clear_on_exit => 1,
 29            #-debug => 1,
 30            -color_support => 1,
 31            inline_states => {
 32                _start => sub {
 33                    $_[HEAP]->{ua} = POE::Component::Client::HTTP->spawn(Alias => 'ua', Timeout => 20, FollowRedirects => 1);
 34                },
 35                http_response => sub { 
 36                    my $method = $_[10]->[1];
 37                    $self->$method(@_);
 38                },
 39            }
 40        )
 41    }
 42);
 43
 44has window => (
 45    is => 'ro',
 46    builder => 1,
 47    lazy => 1,
 48);
 49
 50sub _build_window {
 51    shift->ui->add(
 52        'window', 'Window',
 53        -title => "DuckDuckGo",
 54        -titlefullwidth => 1,
 55        -border => 1,
 56        -bfg => "black",
 57        -titlereverse => 0,
 58    )
 59}
 60
 61has widgets => (
 62    is => 'ro',
 63    builder => 1,
 64    lazy => 1,
 65);
 66
 67has result_wrapper => (
 68    is => 'ro',
 69    builder => 1,
 70    lazy => 1,
 71);
 72
 73sub _build_result_wrapper {
 74    my $self = shift;
 75    $self->window->add(
 76        'res_wrap', 'Container',
 77        -vscrollbar => 'right',
 78        #-height => $self->window->height - $self->widgets->{searchbox}->height - 3, # make it fit between the entry and the "statusbar"
 79    ) 
 80}
 81
 82sub _build_widgets {
 83    my $self = shift;
 84    {
 85        searchbox => $self->window->add(
 86            undef, 'TextEntry',
 87            -border => 1,
 88            -bfg => 'red',
 89            -onblur => sub { $self->ui->clear_binding(KEY_ENTER) }
 90        ),
 91        zci_box => $self->result_wrapper->add(
 92            undef, 'Listbox',
 93            -htmltext => 1,
 94            -border => 1,
 95            -titlereverse => 0,
 96            -userdata => {name => 'zci'}
 97        ),
 98        deep_box => $self->result_wrapper->add(
 99            undef, 'ResultBox',
100            -htmltext => 1,
101            #-vscrollbar => 'right',
102            -userdata => {name => 'deep'}
103        ),
104        statusbar => $self->window->add(
105            undef, 'TextViewer',
106            -singleline => 1,
107            -text => "",
108            -y => $self->window->height - 3,
109            -fg => 'blue',
110        ),
111        autocompleter => $self->window->add(
112            undef, 'Listbox',
113            -htmltext => 1,
114            -y => $self->result_wrapper->{-y},
115            -height => 0,
116        ),
117        window => $self->window,
118        result_wrapper => $self->result_wrapper,
119    }
120}
121
122has ddg => (
123    is => 'ro',
124    default => sub {
125        WWW::DuckDuckGo->new(
126            params => { t => 'cli', %{shift->config->{params}} },
127            http_agent_name => "App::DuckDuckGo::UI/$VERSION",
128        )
129    }
130);
131
132sub scale {
133    # properly scale the two result listboxes
134    my $self = shift;
135    my $top = $self->widgets->{searchbox}{-y} + $self->widgets->{searchbox}->height;
136    $self->result_wrapper->{-height} = $self->window->height - $self->widgets->{searchbox}->height - 3;
137    $self->result_wrapper->{-y} = $top;
138    $self->widgets->{zci_box}{-height} = ($#{$self->widgets->{zci_box}->values})+$top;
139    $self->widgets->{zci_box}->layout;
140    $self->widgets->{deep_box}{-y} = $top + $self->widgets->{zci_box}->canvasheight;
141    #$deep_box->{-height} = $res_wrap->canvasheight - $zci_box->height;
142    $_->layout and $_->draw for ($self->widgets->{zci_box}, $self->widgets->{deep_box}, $self->window);
143}
144
145sub set_results {
146    my ($self, $box) = (shift, shift);
147    # takes the name of a listbox, and an array of hashrefs ({ URL => description })
148    my @values;
149    my %labels;
150    for my $result (@_) {
151        push @values, $_ for keys %{$result};
152        for (keys %{$result}) {
153            my $desc = $$result{$_};
154            $desc =~ s/'''//g;
155            $labels{$_} = $desc;
156        }
157    }
158    if (!@values) {
159        print STDERR "No values, hiding box $box\n";
160        $self->widgets->{$box}->hide;
161    } else {
162        $self->widgets->{$box}->show;
163        $self->widgets->{$box}->values(\@values);
164        $self->widgets->{$box}->labels(\%labels);
165    }
166    $self->scale;
167}
168
169sub autocomplete_and_add {
170    my ($self, $searchbox, $char) = @_;
171
172    $searchbox->add_string($char);
173
174    my $results = $self->autocomplete($searchbox->text);
175
176    return $searchbox;
177}
178
179#
180# Semi-logical part
181# 
182
183# Deep results API
184sub fill_deep {
185    my ($self, $request, $response) = @_[OBJECT, ARG0+1, ARG1+1];
186    my @out;
187
188    return unless $response->[0]->content; # no results?
189
190    my $results;
191    eval { $results = from_json($response->[0]->content); };
192    return if $@; # this likes to whine about incomplete or malformed json, just return if it does
193
194    for my $result (@$results) {
195        push @out, { $result->{c} => "<bold>".$result->{t}."</bold>\n".($result->{a} ? $result->{a} : $result->{c}) } if defined $result->{c} and defined $result->{t};
196    }
197    $self->set_results(deep_box => @out);
198}
199
200sub deep {
201    my ($self, $call) = @_;
202    my $request = HTTP::Request->new(GET => "https://api.duckduckgo.com/$call");
203    POE::Kernel->post('ua', 'request', 'http_response', $request, 'fill_deep');
204}
205
206# Autocompletion!
207sub fill_ac {
208    my ($self, $request, $response) = @_[OBJECT, ARG0+1, ARG1+1];
209    $self->widgets->{zci_box}->values(from_json($response->[0]->content)->[1]);
210    $self->widgets->{zci_box}->title(undef);
211
212    $self->scale;
213}
214
215sub autocomplete {
216    my ($self, $text) = @_;
217    my $request = HTTP::Request->new(GET => 'https://duckduckgo.com/ac/?type=list&q=' . uri_encode($text));
218    POE::Kernel->post('ua', 'request', 'http_response', $request, 'fill_ac');
219}
220
221sub duck {
222    my $self = shift;
223    $self->widgets->{searchbox}->text($_[0]);
224    my $zci;
225    eval { $zci = $self->ddg->zci(shift); };
226    if ($@) {
227        $self->ui->error("$@");
228        return;
229    }
230
231    if ($zci->has_redirect) {
232        $self->browse($zci->redirect);
233        return;
234    }
235
236    my @results;
237    
238    if (defined $zci->_json->{Calls} && $zci->_json->{Calls}{deep}) {
239        $self->deep($zci->_json->{Calls}{deep});
240    }
241    
242    $self->widgets->{zci_box}->title(""); # clear the title, in case there is no heading
243    $self->widgets->{zci_box}->title($zci->heading) if $zci->has_heading;
244
245    if ($zci->has_results) {
246        for my $zci_box (@{$zci->results}) {
247            push @results, { $zci_box->first_url => "<bold>".$zci_box->text."</bold>" } if $zci_box->has_first_url && $zci_box->has_text;
248        }
249    }
250
251    if ($zci->has_answer) {
252        push @results, { 0 => "<bold>Answer: </bold>".$zci->answer };
253    }
254
255    if ($zci->has_abstract_text && $zci->has_abstract_url) {
256        push @results, { $zci->abstract_url->as_string => "<bold>Abstract: </bold>".$zci->abstract_text };
257    }
258
259    if ($zci->has_definition && $zci->has_definition_url) {
260        push @results, { $zci->definition_url->as_string => $zci->definition };
261    }
262
263    if ($zci->has_related_topics_sections) {
264        for my $sec (keys %{$zci->related_topics_sections}) {
265            my $section = $zci->related_topics_sections;
266            $section = $$section{$sec};
267            for my $zci_box (@{$section}) {
268                push @results, { $zci_box->first_url => $zci_box->text } if $zci_box->has_first_url && $zci_box->has_text;
269            }
270        }
271    }
272
273    if (scalar @results) {
274        #$self->widgets->{zci_box}->show;
275        $self->set_results(zci_box => @results);
276    } else {
277        # FIXME: Hide the ZCI box when it isn't needed
278        #$self->widgets->{zci_box}->hide;
279        #$self->scale;
280    }
281}
282
283
284#
285# Launch a browser!
286#
287sub browse {
288    my ($self, $URI) = @_;
289    $self->ui->leave_curses;
290    system split(
291        /\s+/,
292        sprintf($self->config->{browser}, "$URI")
293    );
294    $self->ui->error("Error $? ($!) in browser") if $?;
295    $self->ui->reset_curses;
296}
297
298
299#
300# Builtin keybindings
301#
302
303# TODO: Mouse support - directly clicking on results to visit them?
304#$zci_box->onSelectionChange(sub {
305#    browse shift->get_active_value;
306#});
307
308sub default_bindings {
309    my $self = shift;
310    my ($cui, $zci_box, $deep_box, $searchbox, $statusbar) = ($self->ui, $self->widgets->{zci_box}, $self->widgets->{deep_box}, $self->widgets->{searchbox}, $self->widgets->{statusbar});
311    $cui->set_binding(sub {exit}, "\cq");
312    $cui->set_binding(sub {exit}, "\cc");
313
314    $cui->set_binding(sub {
315        my $cui = shift;
316        $cui->layout;
317        $cui->draw;
318    }, "\cl");
319
320    $searchbox->set_binding(sub { $self->duck($searchbox->get) if $searchbox->get; }, KEY_ENTER);
321    $searchbox->set_binding(sub { $zci_box->focus }, KEY_DOWN);
322
323    $_->set_binding(sub { $searchbox->focus }, '/') for ($zci_box, $deep_box);
324
325# Bind space to show a dialog containing the full result
326    $deep_box->set_binding(sub {
327        my $this = shift;
328        my $message = $this->labels->{$this->get_active_value};
329        $message =~ s{^<bold>(.+?)</bold>(?: - )?}{};
330        $cui->dialog(
331            -title => $1,
332            -message => $message . " (".$this->get_active_value.")",
333        );
334    }, ' ');
335
336    $zci_box->set_binding(sub {
337        my $URL = shift->get_active_value;# or ($cui->dialog(shift->get_active_) and return); #TODO: handle value==0 somehow
338        if ($URL !~ m{^[a-z]+://}) { # FIXME: make this handle category pages and post-disambig results
339            #my $q = $1 // $URL; $q =~ s/_/ /g;
340            $self->duck(uri_decode($1 // $URL));
341        } else {
342            $self->browse($URL);
343        }
344    }, $_) for (KEY_ENTER, KEY_RIGHT, "l");
345
346    $deep_box->set_binding(sub {
347        $self->browse(shift->get_active_value);
348    }, $_) for (KEY_ENTER, KEY_RIGHT, "l");
349
350    $deep_box->set_mouse_binding(sub {
351        my ($this, $event, $x, $y) = @_;
352        my $newypos = $this->{-yscrpos} + $y;
353        my $i = (($newypos - ($newypos%2 ? 1 : 0)) + ($this->{-yscrpos} ? $this->{-yscrpos}+0.5 : 0 ) ) /2; print STDERR "clicked: $i\n";
354        #$self->browse($this->values->[$i]) if (@{$this->{-values}} and $newypos >= 0); # FIXME
355        $self->ui->error("Clicker support is buggy and rather broken.\nURL I think you clicked: ".$this->values->[$i]);
356    }, BUTTON1_CLICKED);
357
358# Show the URL
359    $_->onSelectionChange(sub {
360        $statusbar->text(shift->get_active_value);
361        $deep_box->layout; $deep_box->draw;
362        $statusbar->layout; $statusbar->draw;
363    }) for ($zci_box, $deep_box);
364
365    $_->onFocus(sub {
366        $statusbar->text(shift->get_active_value or "");
367        $statusbar->draw;
368    }) for ($zci_box, $deep_box);
369
370#
371# Override the up and down handlers on the listboxes to handle moving between them
372#
373    $_->set_binding(sub {
374        my $this = shift;
375        if ($this->{-ypos} >= $this->{-max_selected} and $this->userdata->{name} eq 'zci') {
376            $deep_box->focus;
377        } else {
378            $this->{-routines}{'option-next'}->($this);
379            #print STDERR "ypos: ".($this->{-ypos}*($this->userdata->{name} eq 'deep' ?2:1) % $this->canvasheight).", canvasheight: ".$this->canvasheight.", yscrpos: ";
380            #$this->{-yscrpos}+=($this->userdata->{name} eq 'deep' ?2:1) unless ($this->{-ypos}*($this->userdata->{name} eq 'deep' ?2:1) % $this->canvasheight);
381            #p $this->{-yscrpos};
382            #$this->draw;
383        }
384    }, KEY_DOWN) for ($zci_box, $deep_box);
385
386    $_->set_binding(sub {
387        my $this = shift;
388        if ($this->{-ypos} == 0) {
389            my $target = $this->userdata->{name} eq 'zci' ? $searchbox : $zci_box;
390            $target->focus;
391        } else {
392            $this->{-routines}{'option-prev'}->($this);
393        }
394    }, KEY_UP) for ($zci_box, $deep_box);
395
396
397    # Autocompleter
398    $searchbox->set_binding(sub { $self->autocomplete_and_add(@_) }, '');
399}
400
401sub configure_widgets {
402    my $self = shift;
403    return unless defined $self->config->{interface};
404    for my $widget (keys %{$self->config->{interface}}) {
405        print STDERR "\"$widget\" is not a valid widget name.\n" and return if not defined $self->widgets->{$widget};
406        for my $key (keys %{$self->config->{interface}{$widget}}) {
407            print STDERR "Setting $key on $widget ...\n";
408
409            $self->widgets->{$widget}{$key} = $self->config->{interface}{$widget}{$key} and next
410                if $key =~ /^-\w+$/;
411
412            if ($key eq 'keys') {
413                for (keys %{$self->config->{interface}{$widget}{keys}}) {
414                    my $key_name = $_;
415                    if (/^<(\w+)>$/) {
416                        $key_name = "KEY_" . uc $1;
417                        $key_name = Curses->$key_name;
418                    }
419                    $self->widgets->{$widget}->set_binding($self->config->{interface}{$widget}{keys}{$_}, $key_name);
420                }
421            }
422            else {
423                print STDERR "Unknown option!";
424            }
425        }
426    }
427}
428
429sub run {
430    my $self = shift;
431    $self->window->layout; $self->window->draw;
432
433    $self->default_bindings;
434    $self->configure_widgets;
435
436    $self->set_results(
437        zci_box =>
438            {'https://duckduckgo.com/'         => '<bold>Homepage</bold>'},
439            {'https://duckduckgo.com/about'    => '<bold>About</bold>'},
440            {'https://duckduckgo.com/goodies/' => '<bold>Goodies</bold>'},
441            {'https://duckduckgo.com/feedback' => '<bold>Feedback</bold>'},
442            {'https://duckduckgo.com/privacy'  => '<bold>Privacy</bold>'},
443    );
444
445    POE::Kernel->run;
446}
447
448
4491;