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