]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/View.pm
switch read-only uses of walk_parts to msg_iter
[public-inbox.git] / lib / PublicInbox / View.pm
1 # Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
3 #
4 # Used for displaying the HTML web interface.
5 # See Documentation/design_www.txt for this.
6 package PublicInbox::View;
7 use strict;
8 use warnings;
9 use URI::Escape qw/uri_escape_utf8/;
10 use Date::Parse qw/str2time/;
11 use Encode qw/find_encoding/;
12 use Encode::MIME::Header;
13 use Email::MIME::ContentType qw/parse_content_type/;
14 use PublicInbox::Hval qw/ascii_html/;
15 use PublicInbox::Linkify;
16 use PublicInbox::MID qw/mid_clean id_compress mid2path mid_mime/;
17 use PublicInbox::MsgIter;
18 require POSIX;
19
20 use constant INDENT => '  ';
21 use constant TCHILD => '` ';
22 sub th_pfx ($) { $_[0] == 0 ? '' : TCHILD };
23
24 # public functions:
25 sub msg_html {
26         my ($ctx, $mime, $footer) = @_;
27         $footer = defined($footer) ? "\n$footer" : '';
28         my $hdr = $mime->header_obj;
29         headers_to_html_header($hdr, $ctx) .
30                 multipart_text_as_html($mime) .
31                 '</pre><hr /><pre>' .
32                 html_footer($hdr, 1, $ctx, 'R/') .
33                 $footer .
34                 '</pre></body></html>';
35 }
36
37 # /$INBOX/$MESSAGE_ID/R/
38 sub msg_reply {
39         my ($ctx, $hdr, $footer) = @_;
40         my $s = $hdr->header('Subject');
41         $s = '(no subject)' if (!defined $s) || ($s eq '');
42         my $f = $hdr->header('From');
43         $f = '' unless defined $f;
44         my $mid = $hdr->header_raw('Message-ID');
45         $mid = PublicInbox::Hval->new_msgid($mid);
46         my $t = ascii_html($s);
47         my $se_url =
48          'https://kernel.org/pub/software/scm/git/docs/git-send-email.html';
49
50         my ($arg, $link) = mailto_arg_link($hdr);
51         push @$arg, '/path/to/YOUR_REPLY';
52
53         "<html><head><title>replying to \"$t\"</title></head><body><pre>" .
54         "replying to message:\n\n" .
55         "Subject: <b>$t</b>\n" .
56         "From: ". ascii_html($f) .
57         "\nDate: " .  ascii_html($hdr->header('Date')) .
58         "\nMessage-ID: &lt;" . $mid->as_html . "&gt;\n\n" .
59         "There are multiple ways to reply:\n\n" .
60         "* Save the following mbox file, import it into your mail client,\n" .
61         "  and reply-to-all from there: <a\nhref=../raw>mbox</a>\n\n" .
62         "* Reply to all the recipients using the <b>--to</b>, <b>--cc</b>,\n" .
63         "  and <b>--in-reply-to</b> switches of git-send-email(1):\n\n" .
64         "\tgit send-email \\\n\t\t" .
65         join(" \\ \n\t\t", @$arg ). "\n\n" .
66         qq(  <a\nhref="$se_url">$se_url</a>\n\n) .
67         "* If your mail client supports setting the <b>In-Reply-To</b>" .
68         " header\n  via mailto: links, try the " .
69         qq(<a\nhref="$link">mailto: link</a>\n) .
70         "\nFor context, the original <a\nhref=../>message</a> or " .
71         qq(<a\nhref="../t/#u">thread</a>) .
72         '</pre><hr /><pre>' . $footer .  '</pre></body></html>';
73 }
74
75 sub in_reply_to {
76         my ($hdr) = @_;
77         my $irt = $hdr->header_raw('In-Reply-To');
78
79         return mid_clean($irt) if (defined $irt);
80
81         my $refs = $hdr->header_raw('References');
82         if ($refs && $refs =~ /<([^>]+)>\s*\z/s) {
83                 return $1;
84         }
85         undef;
86 }
87
88 # this is already inside a <pre>
89 sub index_entry {
90         my ($mime, $level, $state) = @_;
91         my $midx = $state->{anchor_idx}++;
92         my $ctx = $state->{ctx};
93         my $srch = $ctx->{srch};
94         my $hdr = $mime->header_obj;
95         my $subj = $hdr->header('Subject');
96
97         my $mid_raw = mid_clean(mid_mime($mime));
98         my $id = anchor_for($mid_raw);
99         my $seen = $state->{seen};
100         $seen->{$id} = "#$id"; # save the anchor for children, later
101
102         my $mid = PublicInbox::Hval->new_msgid($mid_raw);
103         my $from = $hdr->header('From');
104         my @from = Email::Address->parse($from);
105         $from = $from[0]->name;
106
107         my $root_anchor = $state->{root_anchor} || '';
108         my $path = $root_anchor ? '../../' : '';
109         my $href = $mid->as_href;
110         my $irt = in_reply_to($hdr);
111         my $parent_anchor = $seen->{anchor_for($irt)} if defined $irt;
112
113         $from = ascii_html($from);
114         $subj = ascii_html($subj);
115         $subj = "<a\nhref=\"${path}$href/\">$subj</a>";
116         $subj = "<u\nid=u>$subj</u>" if $root_anchor eq $id;
117
118         my $ts = _msg_date($hdr);
119         my $rv = "<pre\nid=s$midx>";
120         $rv .= "<b\nid=$id>$subj</b>\n";
121         my $txt = "${path}$href/raw";
122         my $fh = $state->{fh};
123         $fh->write($rv .= "- $from @ $ts UTC (<a\nhref=\"$txt\">raw</a>)\n\n");
124
125         my $mhref = "${path}$href/";
126
127         # scan through all parts, looking for displayable text
128         msg_iter($mime, sub { index_walk($fh, $_[0]) });
129         $rv = "\n" . html_footer($hdr, 0, $ctx, "$path$href/R/");
130
131         if (defined $irt) {
132                 unless (defined $parent_anchor) {
133                         my $v = PublicInbox::Hval->new_msgid($irt, 1);
134                         $v = $v->as_href;
135                         $parent_anchor = "${path}$v/";
136                 }
137                 $rv .= " <a\nhref=\"$parent_anchor\">parent</a>";
138         }
139         if (my $pct = $state->{pct}) { # used by SearchView.pm
140                 $rv .= " [relevance $pct->{$mid_raw}%]";
141         } elsif ($srch) {
142                 my $threaded = 'threaded';
143                 my $flat = 'flat';
144                 my $end = '';
145                 if ($ctx->{flat}) {
146                         $flat = "<b>$flat</b>";
147                         $end = "\n"; # for lynx
148                 } else {
149                         $threaded = "<b>$threaded</b>";
150                 }
151                 $rv .= " [<a\nhref=\"${path}$href/t/#u\">$threaded</a>";
152                 $rv .= "|<a\nhref=\"${path}$href/T/#u\">$flat</a>]$end";
153         }
154         $fh->write($rv .= '</pre>');
155 }
156
157 sub thread_html {
158         my ($ctx, $foot, $srch) = @_;
159         # $_[0] in sub is the Plack callback
160         sub { emit_thread_html($_[0], $ctx, $foot, $srch) }
161 }
162
163 # only private functions below.
164
165 sub emit_thread_html {
166         my ($res, $ctx, $foot, $srch) = @_;
167         my $mid = $ctx->{mid};
168         my $flat = $ctx->{flat};
169         my $msgs = load_results($srch->get_thread($mid, { asc => $flat }));
170         my $nr = scalar @$msgs;
171         return missing_thread($res, $ctx) if $nr == 0;
172         my $seen = {};
173         my $state = {
174                 res => $res,
175                 ctx => $ctx,
176                 seen => $seen,
177                 root_anchor => anchor_for($mid),
178                 anchor_idx => 0,
179                 cur_level => 0,
180         };
181
182         require PublicInbox::Git;
183         $ctx->{git} ||= PublicInbox::Git->new($ctx->{git_dir});
184         if ($flat) {
185                 pre_anchor_entry($seen, $_) for (@$msgs);
186                 __thread_entry($state, $_, 0) for (@$msgs);
187         } else {
188                 my $th = thread_results($msgs);
189                 thread_entry($state, $_, 0) for $th->rootset;
190                 if (my $max = $state->{cur_level}) {
191                         $state->{fh}->write(
192                                 ('</ul></li>' x ($max - 1)) . '</ul>');
193                 }
194         }
195         Email::Address->purge_cache;
196
197         # there could be a race due to a message being deleted in git
198         # but still being in the Xapian index:
199         my $fh = delete $state->{fh} or return missing_thread($res, $ctx);
200
201         my $final_anchor = $state->{anchor_idx};
202         my $next = "<a\nid=s$final_anchor>";
203         $next .= $final_anchor == 1 ? 'only message in' : 'end of';
204         $next .= " thread</a>, back to <a\nhref=\"../../\">index</a>";
205         $next .= "\ndownload thread: ";
206         $next .= "<a\nhref=\"../t.mbox.gz\">mbox.gz</a>";
207         $next .= " / follow: <a\nhref=\"../t.atom\">Atom feed</a>";
208         $fh->write('<hr /><pre>' . $next . "\n\n".
209                         $foot .  '</pre></body></html>');
210         $fh->close;
211 }
212
213 sub index_walk {
214         my ($fh, $p) = @_;
215         my $s = add_text_body($p);
216
217         return if $s eq '';
218
219         $s .= "\n"; # ensure there's a trailing newline
220
221         $fh->write($s);
222 }
223
224 sub multipart_text_as_html {
225         my ($mime) = @_;
226         my $rv = "";
227
228         # scan through all parts, looking for displayable text
229         msg_iter($mime, sub {
230                 my ($p) = @_;
231                 $p = add_text_body($p);
232                 $rv .= $p;
233                 $rv .= "\n" if $p ne '';
234         });
235         $rv;
236 }
237
238 sub flush_quote {
239         my ($s, $l, $quot) = @_;
240
241         # show everything in the full version with anchor from
242         # short version (see above)
243         my $rv = $l->linkify_1(join('', @$quot));
244         @$quot = ();
245
246         # we use a <div> here to allow users to specify their own
247         # color for quoted text
248         $rv = $l->linkify_2(ascii_html($rv));
249         $$s .= qq(<span\nclass="q">) . $rv . '</span>'
250 }
251
252 sub attach_link ($$$) {
253         my ($ct, $p, $fn) = @_;
254         my ($part, $depth, @idx) = @$p;
255         my $nl = $idx[-1] > 1 ? "\n" : '';
256         my $idx = join('.', @idx);
257         my $size = bytes::length($part->body);
258         $ct ||= 'text/plain';
259         $ct =~ s/;.*//; # no attributes
260         $ct = ascii_html($ct);
261         my $desc = $part->header('Content-Description');
262         $desc = $fn unless defined $desc;
263         $desc = '' unless defined $desc;
264         $desc = ': '.$desc if $desc;
265         "$nl<b>[-- Attachment #$idx$desc --]\n" .
266         "[-- Type: $ct, Size: $size bytes --]</b>"
267 }
268
269 sub add_text_body {
270         my ($p) = @_; # from msg_iter: [ Email::MIME, depth, @idx ]
271         my ($part, $depth, @idx) = @$p;
272         my $ct = $part->content_type;
273         my $fn = $part->filename;
274
275         if (defined $ct && $ct =~ m!\btext/x?html\b!i) {
276                 return attach_link($ct, $p, $fn);
277         }
278
279         my $s = eval { $part->body_str };
280
281         # badly-encoded message? tell the world about it!
282         return attach_link($ct, $p, $fn) if $@;
283
284         my @lines = split(/^/m, $s);
285         $s = '';
286         if (defined($fn) || $depth > 1 || $idx[0] > 1) {
287                 $s .= attach_link($ct, $p, $fn);
288                 $s .= "\n\n";
289         }
290         my @quot;
291         my $l = PublicInbox::Linkify->new;
292         while (defined(my $cur = shift @lines)) {
293                 if ($cur !~ /^>/) {
294                         # show the previously buffered quote inline
295                         flush_quote(\$s, $l, \@quot) if @quot;
296
297                         # regular line, OK
298                         $cur = $l->linkify_1($cur);
299                         $cur = ascii_html($cur);
300                         $s .= $l->linkify_2($cur);
301                 } else {
302                         push @quot, $cur;
303                 }
304         }
305
306         flush_quote(\$s, $l, \@quot) if @quot;
307         $s =~ s/[ \t]+$//sgm; # kill per-line trailing whitespace
308         $s =~ s/\A\n+//s; # kill leading blank lines
309         $s =~ s/\s+\z//s; # kill all trailing spaces (final "\n" added if ne '')
310         $s;
311 }
312
313 sub headers_to_html_header {
314         my ($hdr, $ctx) = @_;
315         my $srch = $ctx->{srch} if $ctx;
316         my $atom = '';
317         my $rv = '';
318         my $upfx = '';
319
320         if ($srch) {
321                 $atom = qq{<link\nrel=alternate\ntitle="Atom feed"\n} .
322                         qq!href="${upfx}t.atom"\ntype="application/atom+xml"/>!;
323         }
324
325         my @title;
326         my $mid = $hdr->header_raw('Message-ID');
327         $mid = PublicInbox::Hval->new_msgid($mid);
328         foreach my $h (qw(From To Cc Subject Date)) {
329                 my $v = $hdr->header($h);
330                 defined($v) && ($v ne '') or next;
331                 $v = PublicInbox::Hval->new($v);
332
333                 if ($h eq 'From') {
334                         my @from = Email::Address->parse($v->raw);
335                         $title[1] = ascii_html($from[0]->name);
336                 } elsif ($h eq 'Subject') {
337                         $title[0] = $v->as_html;
338                         if ($srch) {
339                                 $rv .= qq($h: <a\nhref="#r"\nid=t>);
340                                 $rv .= $v->as_html . "</a>\n";
341                                 next;
342                         }
343                 }
344                 $rv .= "$h: " . $v->as_html . "\n";
345
346         }
347         $rv .= 'Message-ID: &lt;' . $mid->as_html . '&gt; ';
348         $rv .= "(<a\nhref=\"${upfx}raw\">raw</a>)\n";
349         $rv .= _parent_headers($hdr, $srch);
350         $rv .= "\n";
351
352         ("<html><head><title>".  join(' - ', @title) . "</title>$atom".
353          PublicInbox::Hval::STYLE .
354          "</head><body><pre\nid=b>" . # anchor for body start
355          $rv);
356 }
357
358 sub thread_skel {
359         my ($dst, $ctx, $hdr, $tpfx) = @_;
360         my $srch = $ctx->{srch};
361         my $mid = mid_clean($hdr->header_raw('Message-ID'));
362         my $sres = $srch->get_thread($mid);
363         my $nr = $sres->{total};
364         my $expand = qq(<a\nhref="${tpfx}t/#u">expand</a> ) .
365                         qq(/ <a\nhref="${tpfx}t.mbox.gz">mbox.gz</a> ) .
366                         qq(/ <a\nhref="${tpfx}t.atom">Atom feed</a>);
367
368         my $parent = in_reply_to($hdr);
369         if ($nr <= 1) {
370                 if (defined $parent) {
371                         $$dst .= "($expand)\n ";
372                         $$dst .= ghost_parent("$tpfx../", $parent) . "\n";
373                 } else {
374                         $$dst .= "[no followups, yet] ($expand)\n";
375                 }
376                 $ctx->{next_msg} = undef;
377                 $ctx->{parent_msg} = $parent;
378                 return;
379         }
380
381         $$dst .= "$nr+ messages in thread ($expand";
382         $$dst .= qq! / <a\nhref="#b">[top]</a>)\n!;
383
384         my $subj = $srch->subject_path($hdr->header('Subject'));
385         my $state = {
386                 seen => { $subj => 1 },
387                 srch => $srch,
388                 cur => $mid,
389                 prev_attr => '',
390                 prev_level => 0,
391         };
392         for (thread_results(load_results($sres))->rootset) {
393                 skel_dump($dst, $state, $tpfx, $_, 0);
394         }
395         $ctx->{next_msg} = $state->{next_msg};
396         $ctx->{parent_msg} = $parent;
397 }
398
399 sub _parent_headers {
400         my ($hdr, $srch) = @_;
401         my $rv = '';
402
403         my $irt = in_reply_to($hdr);
404         if (defined $irt) {
405                 my $v = PublicInbox::Hval->new_msgid($irt, 1);
406                 my $html = $v->as_html;
407                 my $href = $v->as_href;
408                 $rv .= "In-Reply-To: &lt;";
409                 $rv .= "<a\nhref=\"../$href/\">$html</a>&gt;\n";
410         }
411
412         # do not display References: if search is present,
413         # we show the thread skeleton at the bottom, instead.
414         return $rv if $srch;
415
416         my $refs = $hdr->header_raw('References');
417         if ($refs) {
418                 # avoid redundant URLs wasting bandwidth
419                 my %seen;
420                 $seen{$irt} = 1 if defined $irt;
421                 my @refs;
422                 my @raw_refs = ($refs =~ /<([^>]+)>/g);
423                 foreach my $ref (@raw_refs) {
424                         next if $seen{$ref};
425                         $seen{$ref} = 1;
426                         push @refs, linkify_ref_nosrch($ref);
427                 }
428
429                 if (@refs) {
430                         $rv .= 'References: '. join(' ', @refs) . "\n";
431                 }
432         }
433         $rv;
434 }
435
436 sub mailto_arg_link {
437         my ($hdr) = @_;
438         my %cc; # everyone else
439         my $to; # this is the From address
440
441         foreach my $h (qw(From To Cc)) {
442                 my $v = $hdr->header($h);
443                 defined($v) && ($v ne '') or next;
444                 my @addrs = Email::Address->parse($v);
445                 foreach my $recip (@addrs) {
446                         my $address = $recip->address;
447                         my $dst = lc($address);
448                         $cc{$dst} ||= $address;
449                         $to ||= $dst;
450                 }
451         }
452         Email::Address->purge_cache;
453         my @arg;
454
455         my $subj = $hdr->header('Subject') || '';
456         $subj = "Re: $subj" unless $subj =~ /\bRe:/i;
457         my $mid = $hdr->header_raw('Message-ID');
458         push @arg, "--in-reply-to='" . ascii_html($mid) . "'";
459         my $irt = uri_escape_utf8($mid);
460         delete $cc{$to};
461         push @arg, '--to=' . ascii_html($to);
462         $to = uri_escape_utf8($to);
463         $subj = uri_escape_utf8($subj);
464         my $cc = join(',', sort values %cc);
465         push @arg, '--cc=' . ascii_html($cc);
466         $cc = uri_escape_utf8($cc);
467         my $href = "mailto:$to?In-Reply-To=$irt&Cc=${cc}&Subject=$subj";
468         $href =~ s/%20/+/g;
469
470         (\@arg, $href);
471 }
472
473 sub html_footer {
474         my ($hdr, $standalone, $ctx, $rhref) = @_;
475
476         my $srch = $ctx->{srch} if $ctx;
477         my $upfx = '../';
478         my $tpfx = '';
479         my $idx = $standalone ? " <a\nhref=\"$upfx\">index</a>" : '';
480         my $irt = '';
481         if ($idx && $srch) {
482                 $idx .= "\n";
483                 thread_skel(\$idx, $ctx, $hdr, $tpfx);
484                 my $p = $ctx->{parent_msg};
485                 my $next = $ctx->{next_msg};
486                 if ($p) {
487                         $p = PublicInbox::Hval->new_msgid($p);
488                         $p = $p->as_href;
489                         $irt = "<a\nhref=\"$upfx$p/\"rel=prev>parent</a> ";
490                 } else {
491                         $irt = ' ' x length('parent ');
492                 }
493                 if ($next) {
494                         my $n = PublicInbox::Hval->new_msgid($next)->as_href;
495                         $irt .= "<a\nhref=\"$upfx$n/\"\nrel=next>next</a> ";
496                 } else {
497                         $irt .= ' ' x length('next ');
498                 }
499         } else {
500                 $irt = '';
501         }
502
503         $irt . qq(<a\nhref="$rhref">reply</a>) . $idx;
504 }
505
506 sub linkify_ref_nosrch {
507         my $v = PublicInbox::Hval->new_msgid($_[0], 1);
508         my $html = $v->as_html;
509         my $href = $v->as_href;
510         "&lt;<a\nhref=\"../$href/\">$html</a>&gt;";
511 }
512
513 sub anchor_for {
514         my ($msgid) = @_;
515         my $id = $msgid;
516         if ($id !~ /\A[a-f0-9]{40}\z/) {
517                 $id = id_compress(mid_clean($id), 1);
518         }
519         'm' . $id;
520 }
521
522 sub thread_html_head {
523         my ($hdr, $state) = @_;
524         my $res = delete $state->{res} or die "BUG: no Plack callback in {res}";
525         my $fh = $res->([200, ['Content-Type'=> 'text/html; charset=UTF-8']]);
526         $state->{fh} = $fh;
527
528         my $s = ascii_html($hdr->header('Subject'));
529         $fh->write("<html><head><title>$s</title>".
530                 qq{<link\nrel=alternate\ntitle="Atom feed"\n} .
531                 qq!href="../t.atom"\ntype="application/atom+xml"/>! .
532                 PublicInbox::Hval::STYLE .
533                 "</head><body>");
534 }
535
536 sub pre_anchor_entry {
537         my ($seen, $mime) = @_;
538         my $id = anchor_for(mid_mime($mime));
539         $seen->{$id} = "#$id"; # save the anchor for children, later
540 }
541
542 sub ghost_parent {
543         my ($upfx, $mid) = @_;
544         # 'subject dummy' is used internally by Mail::Thread
545         return '[no common parent]' if ($mid eq 'subject dummy');
546
547         $mid = PublicInbox::Hval->new_msgid($mid);
548         my $href = $mid->as_href;
549         my $html = $mid->as_html;
550         qq{[parent not found: &lt;<a\nhref="$upfx$href/">$html</a>&gt;]};
551 }
552
553 sub thread_adj_level {
554         my ($state, $level) = @_;
555
556         my $max = $state->{cur_level};
557         if ($level <= 0) {
558                 return '' if $max == 0; # flat output
559
560                 # reset existing lists
561                 my $x = $max > 1 ? ('</ul></li>' x ($max - 1)) : '';
562                 $state->{fh}->write($x . '</ul>');
563                 $state->{cur_level} = 0;
564                 return '';
565         }
566         if ($level == $max) { # continue existing list
567                 $state->{fh}->write('<li>');
568         } elsif ($level < $max) {
569                 my $x = $max > 1 ? ('</ul></li>' x ($max - $level)) : '';
570                 $state->{fh}->write($x .= '<li>');
571                 $state->{cur_level} = $level;
572         } else { # ($level > $max) # start a new level
573                 $state->{cur_level} = $level;
574                 $state->{fh}->write(($max ? '<li>' : '') . '<ul><li>');
575         }
576         '</li>';
577 }
578
579 sub ghost_flush {
580         my ($state, $upfx, $mid, $level) = @_;
581         my $end = '<pre>'. ghost_parent($upfx, $mid) . '</pre>';
582         $state->{fh}->write($end .= thread_adj_level($state, $level));
583 }
584
585 sub __thread_entry {
586         my ($state, $mime, $level) = @_;
587
588         # lazy load the full message from mini_mime:
589         $mime = eval {
590                 my $path = mid2path(mid_clean(mid_mime($mime)));
591                 Email::MIME->new($state->{ctx}->{git}->cat_file('HEAD:'.$path));
592         } or return;
593
594         thread_html_head($mime, $state) if $state->{anchor_idx} == 0;
595         if (my $ghost = delete $state->{ghost}) {
596                 # n.b. ghost messages may only be parents, not children
597                 foreach my $g (@$ghost) {
598                         ghost_flush($state, '../../', @$g);
599                 }
600         }
601         my $end = thread_adj_level($state, $level);
602         index_entry($mime, $level, $state);
603         $state->{fh}->write($end) if $end;
604
605         1;
606 }
607
608 sub indent_for {
609         my ($level) = @_;
610         INDENT x ($level - 1);
611 }
612
613 sub __ghost_prepare {
614         my ($state, $node, $level) = @_;
615         my $ghost = $state->{ghost} ||= [];
616         push @$ghost, [ $node->messageid, $level ];
617 }
618
619 sub thread_entry {
620         my ($state, $node, $level) = @_;
621         return unless $node;
622         if (my $mime = $node->message) {
623                 unless (__thread_entry($state, $mime, $level)) {
624                         __ghost_prepare($state, $node, $level);
625                 }
626         } else {
627                 __ghost_prepare($state, $node, $level);
628         }
629
630         thread_entry($state, $node->child, $level + 1);
631         thread_entry($state, $node->next, $level);
632 }
633
634 sub load_results {
635         my ($sres) = @_;
636
637         [ map { $_->mini_mime } @{delete $sres->{msgs}} ];
638 }
639
640 sub msg_timestamp {
641         my ($hdr) = @_;
642         my $ts = eval { str2time($hdr->header('Date')) };
643         defined($ts) ? $ts : 0;
644 }
645
646 sub thread_results {
647         my ($msgs) = @_;
648         require PublicInbox::Thread;
649         my $th = PublicInbox::Thread->new(@$msgs);
650         $th->thread;
651         $th->order(*sort_ts);
652         $th
653 }
654
655 sub missing_thread {
656         my ($res, $ctx) = @_;
657         require PublicInbox::ExtMsg;
658
659         $res->(PublicInbox::ExtMsg::ext_msg($ctx))
660 }
661
662 sub _msg_date {
663         my ($hdr) = @_;
664         my $ts = $hdr->header('X-PI-TS') || msg_timestamp($hdr);
665         fmt_ts($ts);
666 }
667
668 sub fmt_ts { POSIX::strftime('%Y-%m-%d %k:%M', gmtime($_[0])) }
669
670 sub _skel_header {
671         my ($dst, $state, $upfx, $hdr, $level) = @_;
672
673         my $cur = $state->{cur};
674         my $mid = mid_clean($hdr->header_raw('Message-ID'));
675         my $f = ascii_html($hdr->header('X-PI-From'));
676         my $d = _msg_date($hdr);
677         my $pfx = "$d " . indent_for($level) . th_pfx($level);
678         my $attr = $f;
679         $state->{first_level} ||= $level;
680
681         if ($attr ne $state->{prev_attr} || $state->{prev_level} > $level) {
682                 $state->{prev_attr} = $attr;
683         } else {
684                 $attr = '';
685         }
686         $state->{prev_level} = $level;
687
688         if ($cur) {
689                 if ($cur eq $mid) {
690                         delete $state->{cur};
691                         $$dst .= "$pfx<b><a\nid=r\nhref=\"#t\">".
692                                  "$attr [this message]</a></b>\n";
693
694                         return;
695                 }
696         } else {
697                 $state->{next_msg} ||= $mid;
698         }
699
700         # Subject is never undef, this mail was loaded from
701         # our Xapian which would've resulted in '' if it were
702         # really missing (and Filter rejects empty subjects)
703         my $s = $hdr->header('Subject');
704         my $h = $state->{srch}->subject_path($s);
705         if ($state->{seen}->{$h}) {
706                 $s = undef;
707         } else {
708                 $state->{seen}->{$h} = 1;
709                 $s = PublicInbox::Hval->new($s);
710                 $s = $s->as_html;
711         }
712         my $m = PublicInbox::Hval->new_msgid($mid);
713         $m = $upfx . '../' . $m->as_href . '/';
714         $$dst .= "$pfx<a\nhref=\"$m\">";
715         $$dst .= defined($s) ? "$s</a> $f\n" : "$f</a>\n";
716 }
717
718 sub skel_dump {
719         my ($dst, $state, $upfx, $node, $level) = @_;
720         return unless $node;
721         if (my $mime = $node->message) {
722                 my $hdr = $mime->header_obj;
723                 my $mid = mid_clean($hdr->header_raw('Message-ID'));
724                 _skel_header($dst, $state, $upfx, $hdr, $level);
725         } else {
726                 my $mid = $node->messageid;
727                 if ($mid eq 'subject dummy') {
728                         $$dst .= "\t[no common parent]\n";
729                 } else {
730                         $$dst .= '     [not found] ';
731                         $$dst .= indent_for($level) . th_pfx($level);
732                         $mid = PublicInbox::Hval->new_msgid($mid);
733                         my $href = "$upfx../" . $mid->as_href . '/';
734                         my $html = $mid->as_html;
735                         $$dst .= qq{&lt;<a\nhref="$href">$html</a>&gt;\n};
736                 }
737         }
738         skel_dump($dst, $state, $upfx, $node->child, $level+1);
739         skel_dump($dst, $state, $upfx, $node->next, $level);
740 }
741
742 sub sort_ts {
743         sort {
744                 (eval { $a->topmost->message->header('X-PI-TS') } || 0) <=>
745                 (eval { $b->topmost->message->header('X-PI-TS') } || 0)
746         } @_;
747 }
748
749 # accumulate recent topics if search is supported
750 # returns 1 if done, undef if not
751 sub add_topic {
752         my ($state, $node, $level) = @_;
753         return unless $node;
754         my $child_adjust = 1;
755
756         if (my $x = $node->message) {
757                 $x = $x->header_obj;
758                 my $subj;
759
760                 $subj = $x->header('Subject');
761                 $subj = $state->{srch}->subject_normalized($subj);
762
763                 if (++$state->{subjs}->{$subj} == 1) {
764                         push @{$state->{order}}, [ $level, $subj ];
765                 }
766
767                 my $mid = mid_clean($x->header_raw('Message-ID'));
768
769                 my $ts = $x->header('X-PI-TS');
770                 my $exist = $state->{latest}->{$subj};
771                 if (!$exist || $exist->[1] < $ts) {
772                         $state->{latest}->{$subj} = [ $mid, $ts ];
773                 }
774         } else {
775                 # ghost message, do not bump level
776                 $child_adjust = 0;
777         }
778
779         add_topic($state, $node->child, $level + $child_adjust);
780         add_topic($state, $node->next, $level);
781 }
782
783 sub emit_topics {
784         my ($state) = @_;
785         my $order = $state->{order};
786         my $subjs = $state->{subjs};
787         my $latest = $state->{latest};
788         my $fh = $state->{fh};
789         return $fh->write("\n[No topics in range]</pre>") unless scalar @$order;
790         my $pfx;
791         my $prev = 0;
792         my $prev_attr = '';
793         my $cur;
794         my @recent;
795         while (defined(my $info = shift @$order)) {
796                 my ($level, $subj) = @$info;
797                 my $n = delete $subjs->{$subj};
798                 my ($mid, $ts) = @{delete $latest->{$subj}};
799                 $mid = PublicInbox::Hval->new_msgid($mid)->as_href;
800                 $subj = PublicInbox::Hval->new($subj)->as_html;
801                 $pfx = indent_for($level);
802                 my $nl = $level == $prev ? "\n" : '';
803                 if ($nl && $cur) {
804                         push @recent, $cur;
805                         $cur = undef;
806                 }
807                 $cur ||= [ $ts, '' ];
808                 $cur->[0] = $ts if $ts > $cur->[0];
809                 $cur->[1] .= $nl . $pfx . th_pfx($level) .
810                                 "<a\nhref=\"$mid/t/#u\"><b>" .
811                                 $subj . "</b></a>\n";
812
813                 $ts = fmt_ts($ts);
814                 my $attr = " $ts UTC";
815
816                 # $n isn't the total number of posts on the topic,
817                 # just the number of posts in the current results window
818                 $n = $n == 1 ? '' : " ($n+ messages)";
819
820                 if ($level == 0 || $attr ne $prev_attr) {
821                         my $mbox = qq(<a\nhref="$mid/t.mbox.gz">mbox.gz</a>);
822                         my $atom = qq(<a\nhref="$mid/t.atom">Atom</a>);
823                         $pfx .= INDENT if $level > 0;
824                         $cur->[1] .= $pfx . $attr . $n . " - $mbox / $atom\n";
825                         $prev_attr = $attr;
826                 }
827         }
828         push @recent, $cur if $cur;
829         @recent = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @recent;
830         $fh->write(join('', @recent) . '</pre>');
831 }
832
833 sub emit_index_topics {
834         my ($state) = @_;
835         my $off = $state->{ctx}->{cgi}->param('o');
836         $off = 0 unless defined $off;
837         $state->{order} = [];
838         $state->{subjs} = {};
839         $state->{latest} = {};
840         my $max = 25;
841         my %opts = ( offset => int $off, limit => $max * 4 );
842         while (scalar @{$state->{order}} < $max) {
843                 my $sres = $state->{srch}->query('', \%opts);
844                 my $nr = scalar @{$sres->{msgs}} or last;
845
846                 for (thread_results(load_results($sres))->rootset) {
847                         add_topic($state, $_, 0);
848                 }
849                 $opts{offset} += $nr;
850         }
851
852         emit_topics($state);
853         $opts{offset};
854 }
855
856 1;