lib/PublicInbox/View.pm

   1 # Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
   2 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
   3 package PublicInbox::View;
   4 use strict;
   5 use warnings;
   6 use CGI qw/escapeHTML escape/;
   7 use Encode qw/decode encode/;
   8 use Encode::MIME::Header;
   9
  10 # only one public function:
  11 sub as_html {
  12         my ($class, $mime, $full_pfx) = @_;
  13
  14         headers_to_html_header($mime) .
  15                 multipart_text_as_html($mime, $full_pfx) .
  16                 "</pre>\n";
  17 }
  18
  19 # only private functions below.
  20
  21 sub multipart_text_as_html {
  22         my ($mime, $full_pfx) = @_;
  23         my $rv = "";
  24         my $part_nr = 0;
  25
  26         # scan through all parts, looking for displayable text
  27         $mime->walk_parts(sub {
  28                 my ($part) = @_;
  29                 return if $part->subparts; # walk_parts already recurses
  30
  31                 my $part_type = $part->content_type;
  32                 if ($part_type =~ m!\btext/[a-z0-9\+\._-]+\b!i) {
  33                         my $fn = $part->filename;
  34
  35                         if ($part_nr > 0) {
  36                                 defined($fn) or $fn = "part #" . ($part_nr + 1);
  37                                 $rv .= add_filename_line($fn);
  38                         }
  39
  40                         if (defined $full_pfx) {
  41                                 $rv .= add_text_body_short($part, $part_nr,
  42                                                         $full_pfx);
  43                         } else {
  44                                 $rv .= add_text_body_full($part, $part_nr);
  45                         }
  46                         $rv .= "\n" unless $rv =~ /\n\z/s;
  47                 } else {
  48                         $rv .= "-- part #" . ($part_nr + 1) . " ";
  49                         $rv .= escapeHTML($part_type);
  50                         $rv .= " skipped\n";
  51                 }
  52                 ++$part_nr;
  53         });
  54         $rv;
  55 }
  56
  57 sub add_filename_line {
  58         my ($fn) = @_;
  59         my $len = 72;
  60         my $pad = "-";
  61
  62         $len -= length($fn);
  63         $pad x= ($len/2) if ($len > 0);
  64         "$pad " . escapeHTML($fn) . " $pad\n";
  65 }
  66
  67 sub add_text_body_short {
  68         my ($part, $part_nr, $full_pfx) = @_;
  69         my $n = 0;
  70         my $s = escapeHTML($part->body);
  71         $s =~ s!^((?:(?:&gt;[^\n]+)\n)+)!
  72                 my $cur = $1;
  73                 my @lines = split(/\n/, $cur);
  74                 if (@lines > 1) {
  75                         # show a short snippet of quoted text
  76                         $cur = join(' ', @lines);
  77                         $cur =~ s/&gt; ?//g;
  78
  79                         my @sum = split(/\s+/, $cur);
  80                         $cur = '';
  81                         do {
  82                                 $cur .= shift(@sum) . ' ';
  83                         } while (@sum && length($cur) < 68);
  84                         $cur=~ s/ \z/ .../;
  85                         "&gt; &lt;<a href=${full_pfx}#q${part_nr}_" . $n++ .
  86                                 ">$cur<\/a>&gt;";
  87                 } else {
  88                         $cur;
  89                 }
  90         !emg;
  91         $s;
  92 }
  93
  94 sub add_text_body_full {
  95         my ($part, $part_nr) = @_;
  96         my $n = 0;
  97         my $s = escapeHTML($part->body);
  98         $s =~ s!^((?:(?:&gt;[^\n]+)\n)+)!
  99                 my $cur = $1;
 100                 my @lines = split(/\n/, $cur);
 101                 if (@lines > 1) {
 102                         "<a name=q${part_nr}_" . $n++ . ">$cur</a>";
 103                 } else {
 104                         $cur;
 105                 }
 106         !emg;
 107         $s;
 108 }
 109
 110 sub trim_message_id {
 111         my ($mid) = @_;
 112         $mid =~ tr/<>//d;
 113         my $html = escapeHTML($mid);
 114         my $href = escapeHTML(escape($mid));
 115
 116         ($html, $href);
 117 }
 118
 119 sub headers_to_html_header {
 120         my ($simple) = @_;
 121
 122         my $rv = "";
 123         my @title;
 124         foreach my $h (qw(From To Cc Subject Date)) {
 125                 my $v = $simple->header($h);
 126                 defined $v or next;
 127                 $v = decode("MIME-Header", $v);
 128                 $v = encode("utf8", $v);
 129                 $v = escapeHTML($v);
 130                 $v =~ tr/\n/ /;
 131                 $rv .= "$h: $v\n";
 132
 133                 if ($h eq "From" || $h eq "Subject") {
 134                         push @title, $v;
 135                 }
 136         }
 137
 138         my $mid = $simple->header('Message-ID');
 139         if (defined $mid) {
 140                 my ($html, $href) = trim_message_id($mid);
 141                 $rv .= "Message-ID: <a href=$href.html>$html</a> ";
 142                 $rv .= "(<a href=$href.txt>raw message</a>)\n";
 143         }
 144
 145         my $irp = $simple->header('In-Reply-To');
 146         if (defined $irp) {
 147                 my ($html, $href) = trim_message_id($irp);
 148                 $rv .= "In-Reply-To: <a href=$href.html>$html</a>\n";
 149         }
 150         $rv .= "\n";
 151
 152         return ("<html><head><title>".
 153                 join(' - ', @title) .
 154                 '</title></head><body><pre style="white-space:pre-wrap">' .
 155                 $rv);
 156 }
 157
 158 1;