]> Sergey Matveev's repositories - public-inbox.git/blobdiff - lib/PublicInbox/SearchView.pm
www: more descriptive pagination
[public-inbox.git] / lib / PublicInbox / SearchView.pm
index 3b3afdee3db7e99d01e4ac7ac6383b4b6ccf1fd5..892e8fdae14038098bc9cd9ae21f5dcd97b2a1fc 100644 (file)
@@ -1,58 +1,68 @@
-# Copyright (C) 2015-2018 all contributors <meta@public-inbox.org>
+# Copyright (C) 2015-2020 all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # Displays search results for the web interface
 package PublicInbox::SearchView;
 use strict;
-use warnings;
-use URI::Escape qw(uri_unescape uri_escape);
-use PublicInbox::SearchMsg;
-use PublicInbox::Hval qw/ascii_html obfuscate_addrs/;
+use v5.10.1;
+use List::Util qw(min max);
+use URI::Escape qw(uri_unescape);
+use PublicInbox::Smsg;
+use PublicInbox::Hval qw(ascii_html obfuscate_addrs mid_href fmt_ts);
 use PublicInbox::View;
 use PublicInbox::WwwAtomStream;
-use PublicInbox::MID qw(MID_ESC);
-use PublicInbox::MIME;
-require PublicInbox::Git;
-require PublicInbox::SearchThread;
-our $LIM = 200;
-
-sub noop {}
+use PublicInbox::WwwStream qw(html_oneshot);
+use PublicInbox::SearchThread;
+use PublicInbox::SearchQuery;
+use PublicInbox::Search qw(mdocid);
+my %rmap_inc;
 
 sub mbox_results {
        my ($ctx) = @_;
        my $q = PublicInbox::SearchQuery->new($ctx->{qp});
-       my $x = $q->{x};
+       if ($ctx->{env}->{'psgi.input'}->read(my $buf, 3)) {
+               $q->{t} = 1 if $buf =~ /\Ax=[^0]/;
+       }
        require PublicInbox::Mbox;
-       return PublicInbox::Mbox::mbox_all($ctx, $q->{'q'}) if $x eq 'm';
-       sres_top_html($ctx);
+       $q->{x} eq 'm' ? PublicInbox::Mbox::mbox_all($ctx, $q) :
+                       sres_top_html($ctx);
 }
 
 sub sres_top_html {
        my ($ctx) = @_;
+       my $srch = $ctx->{-inbox}->search or
+               return PublicInbox::WWW::need($ctx, 'Search');
        my $q = PublicInbox::SearchQuery->new($ctx->{qp});
        my $x = $q->{x};
        my $query = $q->{'q'};
+       my $o = $q->{o};
+       my $asc;
+       if ($o < 0) {
+               $asc = 1;
+               $o = -($o + 1); # so [-1] is the last element, like Perl lists
+       }
 
        my $code = 200;
        # double the limit for expanded views:
        my $opts = {
                limit => $q->{l},
-               offset => $q->{o},
+               offset => $o,
                mset => 1,
                relevance => $q->{r},
+               thread => $q->{t},
+               asc => $asc,
        };
-       my ($mset, $total, $err, $cb);
+       my ($mset, $total, $err, $html);
 retry:
        eval {
-               $mset = $ctx->{srch}->query($query, $opts);
+               $mset = $srch->query($query, $opts);
                $total = $mset->get_matches_estimated;
        };
        $err = $@;
        ctx_prepare($q, $ctx);
        if ($err) {
                $code = 400;
-               $ctx->{-html_tip} = '<pre>'.err_txt($ctx, $err).'</pre><hr>';
-               $cb = *noop;
+               $html = '<pre>'.err_txt($ctx, $err).'</pre><hr>';
        } elsif ($total == 0) {
                if (defined($ctx->{-uxs_retried})) {
                        # undo retry damage:
@@ -63,30 +73,16 @@ retry:
                        goto retry;
                }
                $code = 404;
-               $ctx->{-html_tip} = "<pre>\n[No results found]</pre><hr>";
-               $cb = *noop;
+               $html = "<pre>\n[No results found]</pre><hr>";
        } else {
                return adump($_[0], $mset, $q, $ctx) if $x eq 'A';
 
                $ctx->{-html_tip} = search_nav_top($mset, $q, $ctx);
-               if ($x eq 't') {
-                       $cb = mset_thread($ctx, $mset, $q);
-               } else {
-                       $cb = mset_summary($ctx, $mset, $q);
-               }
-       }
-       PublicInbox::WwwStream->response($ctx, $code, $cb);
-}
-
-# allow undef for individual doc loads...
-sub load_doc_retry {
-       my ($srch, $mitem) = @_;
-
-       eval {
-               $srch->retry_reopen(sub {
-                       PublicInbox::SearchMsg->load_doc($mitem->get_document)
-               });
+               return mset_thread($ctx, $mset, $q) if $x eq 't';
+               mset_summary($ctx, $mset, $q); # appends to {-html_tip}
+               $html = '';
        }
+       html_oneshot($ctx, $code);
 }
 
 # display non-nested search results similar to what users expect from
@@ -98,41 +94,72 @@ sub mset_summary {
        my $pad = length("$total");
        my $pfx = ' ' x $pad;
        my $res = \($ctx->{-html_tip});
-       my $srch = $ctx->{srch};
        my $ibx = $ctx->{-inbox};
        my $obfs_ibx = $ibx->{obfuscate} ? $ibx : undef;
+       my @nums = @{$ibx->search->mset_to_artnums($mset)};
+       my %num2msg = map { $_->{num} => $_ } @{$ibx->over->get_all(@nums)};
+       my ($min, $max);
+
        foreach my $m ($mset->items) {
                my $rank = sprintf("%${pad}d", $m->get_rank + 1);
-               my $pct = $m->get_percent;
-               my $smsg = load_doc_retry($srch, $m);
-               unless ($smsg) {
+               my $pct = get_pct($m);
+               my $num = shift @nums;
+               my $smsg = delete($num2msg{$num}) or do {
                        eval {
-                               $m = "$m ".$m->get_docid . " expired\n";
+                               $m = "$m $num expired\n";
                                $ctx->{env}->{'psgi.errors'}->print($m);
                        };
                        next;
-               }
-               my $s = ascii_html($smsg->subject);
-               my $f = ascii_html($smsg->from_name);
+               };
+               $ctx->{-t_max} //= $smsg->{ts};
+
+               # only when sorting by relevance, ->items is always
+               # ordered descending:
+               $max //= $pct;
+               $min = $pct;
+
+               my $s = ascii_html($smsg->{subject});
+               my $f = ascii_html($smsg->{from_name});
                if ($obfs_ibx) {
                        obfuscate_addrs($obfs_ibx, $s);
                        obfuscate_addrs($obfs_ibx, $f);
                }
-               my $date = PublicInbox::View::fmt_ts($smsg->ds);
-               my $mid = PublicInbox::Hval->new_msgid($smsg->mid)->{href};
+               my $date = fmt_ts($smsg->{ds});
+               my $mid = mid_href($smsg->{mid});
                $s = '(no subject)' if $s eq '';
                $$res .= qq{$rank. <b><a\nhref="$mid/">}.
                        $s . "</a></b>\n";
                $$res .= "$pfx  - by $f @ $date UTC [$pct%]\n\n";
        }
+       if ($q->{r}) { # for descriptions in search_nav_bot
+               $q->{-min_pct} = $min;
+               $q->{-max_pct} = $max;
+       }
        $$res .= search_nav_bot($mset, $q);
-       *noop;
+       undef;
+}
+
+# shorten "/full/path/to/Foo/Bar.pm" to "Foo/Bar.pm" so error
+# messages don't reveal FS layout info in case people use non-standard
+# installation paths
+sub path2inc ($) {
+       my $full = $_[0];
+       if (my $short = $rmap_inc{$full}) {
+               return $short;
+       } elsif (!scalar(keys %rmap_inc) && -e $full) {
+               %rmap_inc = map {; "$INC{$_}" => $_ } keys %INC;
+               # fall back to basename as last resort
+               $rmap_inc{$full} // (split('/', $full))[-1];
+       } else {
+               $full;
+       }
 }
 
 sub err_txt {
        my ($ctx, $err) = @_;
        my $u = $ctx->{-inbox}->base_url($ctx->{env}) . '_/text/help/';
        $err =~ s/^\s*Exception:\s*//; # bad word to show users :P
+       $err =~ s!(\S+)!path2inc($1)!sge;
        $err = ascii_html($err);
        "\nBad query: <b>$err</b>\n" .
                qq{See <a\nhref="$u">$u</a> for help on using search};
@@ -140,7 +167,7 @@ sub err_txt {
 
 sub search_nav_top {
        my ($mset, $q, $ctx) = @_;
-       my $m = $q->qs_html(x => 'm', r => undef);
+       my $m = $q->qs_html(x => 'm', r => undef, t => undef);
        my $rv = qq{<form\naction="?$m"\nmethod="post"><pre>};
        my $initial_q = $ctx->{-uxs_retried};
        if (defined $initial_q) {
@@ -175,93 +202,138 @@ sub search_nav_top {
        }
        my $A = $q->qs_html(x => 'A', r => undef);
        $rv .= qq{|<a\nhref="?$A">Atom feed</a>]};
-       $rv .= qq{\n\t\t\t\t\t\tdownload: };
-       $rv .= qq{<input\ntype=submit\nvalue="mbox.gz"/></pre></form><pre>};
+       if ($ctx->{-inbox}->search->has_threadid) {
+               $rv .= qq{\n\t\t\tdownload mbox.gz: } .
+                       # we set name=z w/o using it since it seems required for
+                       # lynx (but works fine for w3m).
+                       qq{<input\ntype=submit\nname=z\n} .
+                               q{value="results only"/>} .
+                       qq{|<input\ntype=submit\nname=x\n} .
+                               q{value="full threads"/>};
+       } else { # BOFH needs to --reindex
+               $rv .= qq{\n\t\t\t\t\t\tdownload: } .
+                       qq{<input\ntype=submit\nname=z\nvalue="mbox.gz"/>}
+       }
+       $rv .= qq{</pre></form><pre>};
 }
 
 sub search_nav_bot {
        my ($mset, $q) = @_;
        my $total = $mset->get_matches_estimated;
-       my $o = $q->{o};
        my $l = $q->{l};
-       my $end = $o + $mset->size;
-       my $beg = $o + 1;
        my $rv = '</pre><hr><pre id=t>';
+       my $o = $q->{o};
+       my $off = $o < 0 ? -($o + 1) : $o;
+       my $end = $off + $mset->size;
+       my $beg = $off + 1;
+
        if ($beg <= $end) {
-               $rv .= "Results $beg-$end of $total";
-               $rv .= ' (estimated)' if $end != $total;
+               my $approx = $end == $total ? '' : '~';
+               $rv .= "Results $beg-$end of $approx$total";
        } else {
                $rv .= "No more results, only $total";
        }
-       my $n = $o + $l;
+       my ($next, $join, $prev, $nd, $pd);
 
-       if ($n < $total) {
-               my $qs = $q->qs_html(o => $n, l => $l);
-               $rv .= qq{  <a\nhref="?$qs"\nrel=next>next</a>}
-       }
-       if ($o > 0) {
-               $rv .= $n < $total ? '/' : '       ';
-               my $p = $o - $l;
-               my $qs = $q->qs_html(o => ($p > 0 ? $p : 0));
-               $rv .= qq{<a\nhref="?$qs"\nrel=prev>prev</a>};
+       if ($o >= 0) { # sort descending
+               my $n = $o + $l;
+               if ($n < $total) {
+                       $next = $q->qs_html(o => $n, l => $l);
+                       $nd = $q->{r} ? "[&lt;= $q->{-min_pct}%]" : '(older)';
+               }
+               if ($o > 0) {
+                       $join = $n < $total ? ' | ' : "\t";
+                       my $p = $o - $l;
+                       $prev = $q->qs_html(o => ($p > 0 ? $p : 0));
+                       $pd = $q->{r} ? "[&gt;= $q->{-max_pct}%]" : '(newer)';
+               }
+       } else { # o < 0, sort ascending
+               my $n = $o - $l;
+
+               if (-$n < $total) {
+                       $next = $q->qs_html(o => $n, l => $l);
+                       $nd = $q->{r} ? "[&lt;= $q->{-min_pct}%]" : '(newer)';
+               }
+               if ($o < -1) {
+                       $join = -$n < $total ? ' | ' : "\t";
+                       my $p = $o + $l;
+                       $prev = $q->qs_html(o => ($p < 0 ? $p : 0));
+                       $pd = $q->{r} ? "[&gt;= $q->{-max_pct}%]" : '(older)';
+               }
        }
-       $rv .= '</pre>';
+
+       $rv .= qq{  <a\nhref="?$next"\nrel=next>next $nd</a>} if $next;
+       $rv .= $join if $join;
+       $rv .= qq{<a\nhref="?$prev"\nrel=prev>prev $pd</a>} if $prev;
+
+       my $rev = $q->qs_html(o => $o < 0 ? 0 : -1);
+       $rv .= qq{ | <a\nhref="?$rev">reverse</a></pre>};
 }
 
 sub sort_relevance {
-       my ($pct) = @_;
-       sub {
-               [ sort { (eval { $pct->{$b->topmost->{id}} } || 0)
-                               <=>
-                       (eval { $pct->{$a->topmost->{id}} } || 0)
-       } @{$_[0]} ] };
+       [ sort {
+               (eval { $b->topmost->{pct} } // 0) <=>
+               (eval { $a->topmost->{pct} } // 0)
+       } @{$_[0]} ]
+}
+
+sub get_pct ($) {
+       # Capped at "99%" since "100%" takes an extra column in the
+       # thread skeleton view.  <xapian/mset.h> says the value isn't
+       # very meaningful, anyways.
+       my $n = $_[0]->get_percent;
+       $n > 99 ? 99 : $n;
 }
 
 sub mset_thread {
        my ($ctx, $mset, $q) = @_;
-       my %pct;
-       my $srch = $ctx->{srch};
-       my $msgs = $srch->retry_reopen(sub { [ map {
-               my $i = $_;
-               my $smsg = PublicInbox::SearchMsg->load_doc($i->get_document);
-               $pct{$smsg->mid} = $i->get_percent;
-               $smsg;
-       } ($mset->items) ]});
+       my $ibx = $ctx->{-inbox};
+       my $nshard = $ibx->search->{nshard} // 1;
+       my %pct = map { mdocid($nshard, $_) => get_pct($_) } $mset->items;
+       my $msgs = $ibx->over->get_all(keys %pct);
+       $_->{pct} = $pct{$_->{num}} for @$msgs;
        my $r = $q->{r};
+       if ($r) { # for descriptions in search_nav_bot
+               my @pct = values %pct;
+               $q->{-min_pct} = min(@pct);
+               $q->{-max_pct} = max(@pct);
+       }
        my $rootset = PublicInbox::SearchThread::thread($msgs,
-               $r ? sort_relevance(\%pct) : *PublicInbox::View::sort_ds,
+               $r ? \&sort_relevance : \&PublicInbox::View::sort_ds,
                $ctx);
        my $skel = search_nav_bot($mset, $q). "<pre>";
-       my $ibx = $ctx->{-inbox};
        $ctx->{-upfx} = '';
        $ctx->{anchor_idx} = 1;
        $ctx->{cur_level} = 0;
-       $ctx->{dst} = \$skel;
+       $ctx->{skel} = \$skel;
        $ctx->{mapping} = {};
-       $ctx->{pct} = \%pct;
+       $ctx->{searchview} = 1;
        $ctx->{prev_attr} = '';
        $ctx->{prev_level} = 0;
        $ctx->{s_nr} = scalar(@$msgs).'+ results';
 
        # reduce hash lookups in skel_dump
-       $ctx->{-obfuscate} = $ctx->{-inbox}->{obfuscate};
+       $ctx->{-obfs_ibx} = $ibx->{obfuscate} ? $ibx : undef;
        PublicInbox::View::walk_thread($rootset, $ctx,
-               *PublicInbox::View::pre_thread);
+               \&PublicInbox::View::pre_thread);
+
+       # link $INBOX_DIR/description text to "recent" view around
+       # the newest message in this result set:
+       $ctx->{-t_max} = max(map { delete $_->{ts} } @$msgs);
 
        @$msgs = reverse @$msgs if $r;
-       sub {
-               return unless $msgs;
-               my $smsg;
-               while (my $m = pop @$msgs) {
-                       $smsg = $ibx->smsg_mime($m) and last;
-               }
-               if ($smsg) {
-                       return PublicInbox::View::index_entry($smsg, $ctx,
-                               scalar @$msgs);
-               }
-               $msgs = undef;
-               $skel .= "\n</pre>";
-       };
+       $ctx->{msgs} = $msgs;
+       PublicInbox::WwwStream::aresponse($ctx, 200, \&mset_thread_i);
+}
+
+# callback for PublicInbox::WwwStream::getline
+sub mset_thread_i {
+       my ($ctx, $eml) = @_;
+       $ctx->zmore($ctx->html_top) if exists $ctx->{-html_tip};
+       $eml and return PublicInbox::View::eml_entry($ctx, $eml);
+       my $smsg = shift @{$ctx->{msgs}} or
+               $ctx->zmore(${delete($ctx->{skel})});
+       $smsg;
 }
 
 sub ctx_prepare {
@@ -283,69 +355,18 @@ sub ctx_prepare {
 
 sub adump {
        my ($cb, $mset, $q, $ctx) = @_;
-       my $ibx = $ctx->{-inbox};
-       my @items = $mset->items;
-       $ctx->{search_query} = $q;
-       my $srch = $ctx->{srch};
-       PublicInbox::WwwAtomStream->response($ctx, 200, sub {
-               while (my $x = shift @items) {
-                       $x = load_doc_retry($srch, $x);
-                       $x = $ibx->smsg_mime($x) and return $x;
-               }
-               return undef;
-       });
+       $ctx->{ids} = $ctx->{-inbox}->search->mset_to_artnums($mset);
+       $ctx->{search_query} = $q; # used by WwwAtomStream::atom_header
+       PublicInbox::WwwAtomStream->response($ctx, 200, \&adump_i);
 }
 
-package PublicInbox::SearchQuery;
-use strict;
-use warnings;
-use URI::Escape qw(uri_escape);
-use PublicInbox::Hval;
-use PublicInbox::MID qw(MID_ESC);
-
-sub new {
-       my ($class, $qp) = @_;
-
-       my $r = $qp->{r};
-       my ($l) = (($qp->{l} || '') =~ /(\d+)/);
-       $l = $LIM if !$l || $l > $LIM;
-       bless {
-               q => $qp->{'q'},
-               x => $qp->{x} || '',
-               o => (($qp->{o} || '0') =~ /(\d+)/),
-               l => $l,
-               r => (defined $r && $r ne '0'),
-       }, $class;
-}
-
-sub qs_html {
-       my ($self, %over) = @_;
-
-       if (keys %over) {
-               my $tmp = bless { %$self }, ref($self);
-               foreach my $k (keys %over) {
-                       $tmp->{$k} = $over{$k};
-               }
-               $self = $tmp;
-       }
-
-       my $q = uri_escape($self->{'q'}, MID_ESC);
-       $q =~ s/%20/+/g; # improve URL readability
-       my $qs = "q=$q";
-
-       if (my $o = $self->{o}) { # ignore o == 0
-               $qs .= "&amp;o=$o";
-       }
-       if (my $l = $self->{l}) {
-               $qs .= "&amp;l=$l" unless $l == $LIM;
-       }
-       if (my $r = $self->{r}) {
-               $qs .= "&amp;r";
-       }
-       if (my $x = $self->{x}) {
-               $qs .= "&amp;x=$x" if ($x eq 't' || $x eq 'A' || $x eq 'm');
+# callback for PublicInbox::WwwAtomStream::getline
+sub adump_i {
+       my ($ctx) = @_;
+       while (my $num = shift @{$ctx->{ids}}) {
+               my $smsg = eval { $ctx->{-inbox}->over->get_art($num) } or next;
+               return $smsg;
        }
-       $qs;
 }
 
 1;