replying to \"$t\"

here to allow users to specify their own # color for quoted text $rv = $l->linkify_2(ascii_html($rv)); $$s .= qq() . $rv . '' } sub attach_link ($$$$) { my ($upfx, $ct, $p, $fn) = @_; my ($part, $depth, @idx) = @$p; my $nl = $idx[-1] > 1 ? "\n" : ''; my $idx = join('.', @idx); my $size = bytes::length($part->body); $ct ||= 'text/plain'; $ct =~ s/;.*//; # no attributes $ct = ascii_html($ct); my $desc = $part->header('Content-Description'); $desc = $fn unless defined $desc; $desc = '' unless defined $desc; $desc = ': '.$desc if $desc; my $sfn; if (defined $fn && $fn =~ /\A[\w\.-]+[a-zA-Z0-9]\z/) { $sfn = $fn; } elsif ($ct eq 'text/plain') { $sfn = 'a.txt'; } else { $sfn = 'a.bin'; } qq($nl[-- Attachment #$idx$desc --]\n) . "[-- Type: $ct, Size: $size bytes --]" } sub add_text_body { my ($upfx, $p) = @_; # from msg_iter: [ Email::MIME, depth, @idx ] my ($part, $depth, @idx) = @$p; my $ct = $part->content_type; my $fn = $part->filename; if (defined $ct && $ct =~ m!\btext/x?html\b!i) { return attach_link($upfx, $ct, $p, $fn); } my $s = eval { $part->body_str }; # badly-encoded message? tell the world about it! return attach_link($upfx, $ct, $p, $fn) if $@; my @lines = split(/^/m, $s); $s = ''; if (defined($fn) || $depth > 0) { $s .= attach_link($upfx, $ct, $p, $fn); $s .= "\n\n"; } my @quot; my $l = PublicInbox::Linkify->new; while (defined(my $cur = shift @lines)) { if ($cur !~ /^>/) { # show the previously buffered quote inline flush_quote(\$s, $l, \@quot) if @quot; # regular line, OK $cur = $l->linkify_1($cur); $cur = ascii_html($cur); $s .= $l->linkify_2($cur); } else { push @quot, $cur; } } flush_quote(\$s, $l, \@quot) if @quot; $s =~ s/[ \t]+$//sgm; # kill per-line trailing whitespace $s =~ s/\A\n+//s; # kill leading blank lines $s =~ s/\s+\z//s; # kill all trailing spaces (final "\n" added if ne '') $s; } sub headers_to_html_header { my ($hdr, $ctx) = @_; my $srch = $ctx->{srch} if $ctx; my $atom = ''; my $rv = ''; my $upfx = ''; if ($srch) { $atom = qq{!; } my @title; my $mid = $hdr->header_raw('Message-ID'); $mid = PublicInbox::Hval->new_msgid($mid); foreach my $h (qw(From To Cc Subject Date)) { my $v = $hdr->header($h); defined($v) && ($v ne '') or next; $v = PublicInbox::Hval->new($v); if ($h eq 'From') { my @from = Email::Address->parse($v->raw); $title[1] = ascii_html($from[0]->name); } elsif ($h eq 'Subject') { $title[0] = $v->as_html; if ($srch) { $rv .= qq($h: ); $rv .= $v->as_html . "\n"; next; } } $rv .= "$h: " . $v->as_html . "\n"; } $rv .= 'Message-ID: <' . $mid->as_html . '> '; $rv .= "(raw)\n"; $rv .= _parent_headers($hdr, $srch); $rv .= "\n"; ("". join(' - ', @title) . "$atom". PublicInbox::Hval::STYLE . "" . # anchor for body start $rv); } sub thread_skel { my ($dst, $ctx, $hdr, $tpfx) = @_; my $srch = $ctx->{srch}; my $mid = mid_clean($hdr->header_raw('Message-ID')); my $sres = $srch->get_thread($mid); my $nr = $sres->{total}; my $expand = qq(expand ) . qq(/ mbox.gz ) . qq(/ Atom feed); my $parent = in_reply_to($hdr); if ($nr <= 1) { if (defined $parent) { $$dst .= "($expand)\n "; $$dst .= ghost_parent("$tpfx../", $parent) . "\n"; } else { $$dst .= "[no followups, yet] ($expand)\n"; } $ctx->{next_msg} = undef; $ctx->{parent_msg} = $parent; return; } $$dst .= "$nr+ messages in thread ($expand"; $$dst .= qq! / [top])\n!; my $subj = $srch->subject_path($hdr->header('Subject')); my $state = { seen => { $subj => 1 }, srch => $srch, cur => $mid, prev_attr => '', prev_level => 0, }; for (thread_results(load_results($sres))->rootset) { skel_dump($dst, $state, $tpfx, $_, 0); } $ctx->{next_msg} = $state->{next_msg}; $ctx->{parent_msg} = $parent; } sub _parent_headers { my ($hdr, $srch) = @_; my $rv = ''; my $irt = in_reply_to($hdr); if (defined $irt) { my $v = PublicInbox::Hval->new_msgid($irt, 1); my $html = $v->as_html; my $href = $v->as_href; $rv .= "In-Reply-To: <"; $rv .= "$html>\n"; } # do not display References: if search is present, # we show the thread skeleton at the bottom, instead. return $rv if $srch; my $refs = $hdr->header_raw('References'); if ($refs) { # avoid redundant URLs wasting bandwidth my %seen; $seen{$irt} = 1 if defined $irt; my @refs; my @raw_refs = ($refs =~ /<([^>]+)>/g); foreach my $ref (@raw_refs) { next if $seen{$ref}; $seen{$ref} = 1; push @refs, linkify_ref_nosrch($ref); } if (@refs) { $rv .= 'References: '. join(' ', @refs) . "\n"; } } $rv; } sub mailto_arg_link { my ($hdr) = @_; my %cc; # everyone else my $to; # this is the From address foreach my $h (qw(From To Cc)) { my $v = $hdr->header($h); defined($v) && ($v ne '') or next; my @addrs = Email::Address->parse($v); foreach my $recip (@addrs) { my $address = $recip->address; my $dst = lc($address); $cc{$dst} ||= $address; $to ||= $dst; } } Email::Address->purge_cache; my @arg; my $subj = $hdr->header('Subject') || ''; $subj = "Re: $subj" unless $subj =~ /\bRe:/i; my $mid = $hdr->header_raw('Message-ID'); push @arg, "--in-reply-to='" . ascii_html($mid) . "'"; my $irt = uri_escape_utf8($mid); delete $cc{$to}; push @arg, '--to=' . ascii_html($to); $to = uri_escape_utf8($to); $subj = uri_escape_utf8($subj); my $cc = join(',', sort values %cc); push @arg, '--cc=' . ascii_html($cc); $cc = uri_escape_utf8($cc); my $href = "mailto:$to?In-Reply-To=$irt&Cc=${cc}&Subject=$subj"; $href =~ s/%20/+/g; (\@arg, $href); } sub html_footer { my ($hdr, $standalone, $ctx, $rhref) = @_; my $srch = $ctx->{srch} if $ctx; my $upfx = '../'; my $tpfx = ''; my $idx = $standalone ? " index" : ''; my $irt = ''; if ($idx && $srch) { $idx .= "\n"; thread_skel(\$idx, $ctx, $hdr, $tpfx); my $p = $ctx->{parent_msg}; my $next = $ctx->{next_msg}; if ($p) { $p = PublicInbox::Hval->new_msgid($p); $p = $p->as_href; $irt = "parent "; } else { $irt = ' ' x length('parent '); } if ($next) { my $n = PublicInbox::Hval->new_msgid($next)->as_href; $irt .= "next "; } else { $irt .= ' ' x length('next '); } } else { $irt = ''; } $irt . qq(reply) . $idx; } sub linkify_ref_nosrch { my $v = PublicInbox::Hval->new_msgid($_[0], 1); my $html = $v->as_html; my $href = $v->as_href; "<$html>"; } sub anchor_for { my ($msgid) = @_; my $id = $msgid; if ($id !~ /\A[a-f0-9]{40}\z/) { $id = id_compress(mid_clean($id), 1); } 'm' . $id; } sub thread_html_head { my ($hdr, $state) = @_; my $res = delete $state->{res} or die "BUG: no Plack callback in {res}"; my $fh = $res->([200, ['Content-Type'=> 'text/html; charset=UTF-8']]); $state->{fh} = $fh; my $s = ascii_html($hdr->header('Subject')); $fh->write("$s". qq{! . PublicInbox::Hval::STYLE . ""); } sub pre_anchor_entry { my ($seen, $mime) = @_; my $id = anchor_for(mid_mime($mime)); $seen->{$id} = "#$id"; # save the anchor for children, later } sub ghost_parent { my ($upfx, $mid) = @_; # 'subject dummy' is used internally by Mail::Thread return '[no common parent]' if ($mid eq 'subject dummy'); $mid = PublicInbox::Hval->new_msgid($mid); my $href = $mid->as_href; my $html = $mid->as_html; qq{[parent not found: <$html>]}; } sub thread_adj_level { my ($state, $level) = @_; my $max = $state->{cur_level}; if ($level <= 0) { return '' if $max == 0; # flat output # reset existing lists my $x = $max > 1 ? ('' x ($max - 1)) : ''; $state->{fh}->write($x . ''); $state->{cur_level} = 0; return ''; } if ($level == $max) { # continue existing list $state->{fh}->write('

'); } elsif ($level < $max) { my $x = $max > 1 ? ('

' x ($max - $level)) : ''; $state->{fh}->write($x .= '

'); $state->{cur_level} = $level; } else { # ($level > $max) # start a new level $state->{cur_level} = $level; $state->{fh}->write(($max ? '

' : '') . '

'); } '

'. ghost_parent($upfx, $mid) . '

". "$attr [this message]

"; $$dst .= defined($s) ? "$s $f\n" : "$f\n"; } sub skel_dump { my ($dst, $state, $upfx, $node, $level) = @_; return unless $node; if (my $mime = $node->message) { my $hdr = $mime->header_obj; my $mid = mid_clean($hdr->header_raw('Message-ID')); _skel_header($dst, $state, $upfx, $hdr, $level); } else { my $mid = $node->messageid; if ($mid eq 'subject dummy') { $$dst .= "\t[no common parent]\n"; } else { $$dst .= ' [not found] '; $$dst .= indent_for($level) . th_pfx($level); $mid = PublicInbox::Hval->new_msgid($mid); my $href = "$upfx../" . $mid->as_href . '/'; my $html = $mid->as_html; $$dst .= qq{<$html>\n}; } } skel_dump($dst, $state, $upfx, $node->child, $level+1); skel_dump($dst, $state, $upfx, $node->next, $level); } sub sort_ts { sort { (eval { $a->topmost->message->header('X-PI-TS') } || 0) <=> (eval { $b->topmost->message->header('X-PI-TS') } || 0) } @_; } # accumulate recent topics if search is supported # returns 1 if done, undef if not sub add_topic { my ($state, $node, $level) = @_; return unless $node; my $child_adjust = 1; if (my $x = $node->message) { $x = $x->header_obj; my $subj; $subj = $x->header('Subject'); $subj = $state->{srch}->subject_normalized($subj); if (++$state->{subjs}->{$subj} == 1) { push @{$state->{order}}, [ $level, $subj ]; } my $mid = mid_clean($x->header_raw('Message-ID')); my $ts = $x->header('X-PI-TS'); my $exist = $state->{latest}->{$subj}; if (!$exist || $exist->[1] < $ts) { $state->{latest}->{$subj} = [ $mid, $ts ]; } } else { # ghost message, do not bump level $child_adjust = 0; } add_topic($state, $node->child, $level + $child_adjust); add_topic($state, $node->next, $level); } sub emit_topics { my ($state) = @_; my $order = $state->{order}; my $subjs = $state->{subjs}; my $latest = $state->{latest}; my $fh = $state->{fh}; return $fh->write("\n[No topics in range]") unless scalar @$order; my $pfx; my $prev = 0; my $prev_attr = ''; my $cur; my @recent; while (defined(my $info = shift @$order)) { my ($level, $subj) = @$info; my $n = delete $subjs->{$subj}; my ($mid, $ts) = @{delete $latest->{$subj}}; $mid = PublicInbox::Hval->new_msgid($mid)->as_href; $subj = PublicInbox::Hval->new($subj)->as_html; $pfx = indent_for($level); my $nl = $level == $prev ? "\n" : ''; if ($nl && $cur) { push @recent, $cur; $cur = undef; } $cur ||= [ $ts, '' ]; $cur->[0] = $ts if $ts > $cur->[0]; $cur->[1] .= $nl . $pfx . th_pfx($level) . "" . $subj . "\n"; $ts = fmt_ts($ts); my $attr = " $ts UTC"; # $n isn't the total number of posts on the topic, # just the number of posts in the current results window $n = $n == 1 ? '' : " ($n+ messages)"; if ($level == 0 || $attr ne $prev_attr) { my $mbox = qq(mbox.gz); my $atom = qq(Atom); $pfx .= INDENT if $level > 0; $cur->[1] .= $pfx . $attr . $n . " - $mbox / $atom\n"; $prev_attr = $attr; } } push @recent, $cur if $cur; @recent = map { $_->[1] } sort { $b->[0] <=> $a->[0] } @recent; $fh->write(join('', @recent) . ''); } sub emit_index_topics { my ($state) = @_; my $off = $state->{ctx}->{cgi}->param('o'); $off = 0 unless defined $off; $state->{order} = []; $state->{subjs} = {}; $state->{latest} = {}; my $max = 25; my %opts = ( offset => int $off, limit => $max * 4 ); while (scalar @{$state->{order}} < $max) { my $sres = $state->{srch}->query('', \%opts); my $nr = scalar @{$sres->{msgs}} or last; for (thread_results(load_results($sres))->rootset) { add_topic($state, $_, 0); } $opts{offset} += $nr; } emit_topics($state); $opts{offset}; } 1;