Blame


1 38232a0a 2023-05-07 op # GotMArc was written by Omar Polo <op@openbsd.org> and is placed in
2 38232a0a 2023-05-07 op # the public domain. The author hereby disclaims copyright to this
3 38232a0a 2023-05-07 op # source code.
4 38232a0a 2023-05-07 op
5 79cd2b80 2023-05-07 op package SMArc;
6 38232a0a 2023-05-07 op use strict;
7 38232a0a 2023-05-07 op use warnings;
8 38232a0a 2023-05-07 op use v5.32;
9 38232a0a 2023-05-07 op use Exporter;
10 38232a0a 2023-05-07 op use File::Basename;
11 38232a0a 2023-05-07 op
12 38232a0a 2023-05-07 op our @ISA = qw(Exporter);
13 38232a0a 2023-05-07 op our @EXPORT_OK = qw(san urlencode parse initpage endpage index_header
14 38232a0a 2023-05-07 op search thread_header threntry thrslice thrnav);
15 38232a0a 2023-05-07 op
16 38232a0a 2023-05-07 op sub san {
17 38232a0a 2023-05-07 op my $str = shift;
18 38232a0a 2023-05-07 op $str =~ s/&/\&amp;/g;
19 38232a0a 2023-05-07 op $str =~ s/</\&lt;/g;
20 38232a0a 2023-05-07 op $str =~ s/>/\&gt;/g;
21 38232a0a 2023-05-07 op return $str;
22 38232a0a 2023-05-07 op }
23 38232a0a 2023-05-07 op
24 38232a0a 2023-05-07 op sub urlencode {
25 38232a0a 2023-05-07 op my $str = shift;
26 38232a0a 2023-05-07 op unless (defined($str)) {
27 38232a0a 2023-05-07 op my ($pkg, $file, $line) = caller 1;
28 38232a0a 2023-05-07 op die "bad $pkg / $file:$line";
29 38232a0a 2023-05-07 op }
30 38232a0a 2023-05-07 op $str =~ s/([^-_~.A-Za-z0-9])/sprintf("%%%2X", ord($1))/ge;
31 38232a0a 2023-05-07 op return $str;
32 38232a0a 2023-05-07 op }
33 38232a0a 2023-05-07 op
34 38232a0a 2023-05-07 op sub ssan {
35 38232a0a 2023-05-07 op my $str = shift;
36 38232a0a 2023-05-07 op $str =~ s/\s+/ /g;
37 38232a0a 2023-05-07 op $str =~ s/\s+$//;
38 38232a0a 2023-05-07 op return san($str);
39 38232a0a 2023-05-07 op }
40 38232a0a 2023-05-07 op
41 38232a0a 2023-05-07 op sub parse {
42 38232a0a 2023-05-07 op my $line = shift;
43 38232a0a 2023-05-07 op my ($indent, $fname, $date, $from, $subj) = $line =~ m{
44 38232a0a 2023-05-07 op ^([^-]*)- # the indent level
45 38232a0a 2023-05-07 op ([^ ]+)\s # filename
46 38232a0a 2023-05-07 op (\d{4}-\d\d-\d\d[ ]\d\d:\d\d) # date
47 38232a0a 2023-05-07 op <([^>]+)> # from
48 38232a0a 2023-05-07 op (.*) # subject
49 38232a0a 2023-05-07 op }x or die "can't parse: $line";
50 38232a0a 2023-05-07 op
51 38232a0a 2023-05-07 op my $level = length($indent);
52 38232a0a 2023-05-07 op $level = 10 if $indent =~ m/\.\.\d+\.\./;
53 38232a0a 2023-05-07 op
54 38232a0a 2023-05-07 op $from = ssan($from);
55 38232a0a 2023-05-07 op $subj = ssan($subj);
56 38232a0a 2023-05-07 op
57 38232a0a 2023-05-07 op my ($time, $id) = split /\./, basename($fname);
58 38232a0a 2023-05-07 op my $mid = "$time.$id";
59 38232a0a 2023-05-07 op
60 38232a0a 2023-05-07 op return {level => $level, fname => $fname,
61 38232a0a 2023-05-07 op mid => $mid, date => $date, from => $from, subj => $subj};
62 38232a0a 2023-05-07 op }
63 38232a0a 2023-05-07 op
64 38232a0a 2023-05-07 op sub readall {
65 38232a0a 2023-05-07 op my $path = shift;
66 38232a0a 2023-05-07 op local $/ = undef;
67 38232a0a 2023-05-07 op open my $fh, "<", $path or die "can't open $path: $!";
68 38232a0a 2023-05-07 op <$fh>;
69 38232a0a 2023-05-07 op }
70 38232a0a 2023-05-07 op
71 38232a0a 2023-05-07 op my $templates = $ENV{TMPLDIR};
72 38232a0a 2023-05-07 op die 'undefined $TMPLDIR' unless defined $templates;
73 38232a0a 2023-05-07 op
74 38232a0a 2023-05-07 op my $small_logo = readall "$templates/logo-small.html";
75 38232a0a 2023-05-07 op my $hdr = readall "$templates/head.html";
76 38232a0a 2023-05-07 op my $foot = readall "$templates/foot.html";
77 38232a0a 2023-05-07 op my $idxhdr = readall "$templates/index-header.html";
78 38232a0a 2023-05-07 op my $search = readall "$templates/search.html";
79 38232a0a 2023-05-07 op
80 38232a0a 2023-05-07 op sub initpage {
81 38232a0a 2023-05-07 op my ($fh, $title) = @_;
82 38232a0a 2023-05-07 op say $fh $hdr =~ s/TITLE/$title/r;
83 38232a0a 2023-05-07 op }
84 38232a0a 2023-05-07 op
85 38232a0a 2023-05-07 op sub endpage {
86 38232a0a 2023-05-07 op my $fh = shift;
87 38232a0a 2023-05-07 op say $fh $foot;
88 38232a0a 2023-05-07 op }
89 38232a0a 2023-05-07 op
90 38232a0a 2023-05-07 op sub index_header {
91 38232a0a 2023-05-07 op my ($fh, $page, $subtitle) = @_;
92 38232a0a 2023-05-07 op my $html = $idxhdr =~ s/PAGE/$page/r;
93 38232a0a 2023-05-07 op $html =~ s/SUBTITLE/$subtitle/;
94 38232a0a 2023-05-07 op print $fh $html;
95 38232a0a 2023-05-07 op }
96 38232a0a 2023-05-07 op
97 38232a0a 2023-05-07 op sub search {
98 38232a0a 2023-05-07 op my $fh = shift;
99 38232a0a 2023-05-07 op my $html = $search =~ s/QUERY//r;
100 38232a0a 2023-05-07 op print $fh $html;
101 38232a0a 2023-05-07 op }
102 38232a0a 2023-05-07 op
103 38232a0a 2023-05-07 op sub thread_header {
104 38232a0a 2023-05-07 op my ($fh, $e, $mail, $p, $n) = @_;
105 38232a0a 2023-05-07 op
106 38232a0a 2023-05-07 op my @entries = @$e;
107 38232a0a 2023-05-07 op
108 38232a0a 2023-05-07 op my $enctid = urlencode $mail->{tid} if defined $mail;
109 38232a0a 2023-05-07 op my $encmid = urlencode $mail->{mid} if defined $mail;
110 38232a0a 2023-05-07 op
111 38232a0a 2023-05-07 op print $fh "<header class='mail-header'>\n";
112 38232a0a 2023-05-07 op
113 38232a0a 2023-05-07 op print $fh "<p>";
114 38232a0a 2023-05-07 op print $fh $small_logo;
115 38232a0a 2023-05-07 op print $fh "<a href='/'>Index</a>";
116 38232a0a 2023-05-07 op print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
117 38232a0a 2023-05-07 op if defined $enctid;
118 38232a0a 2023-05-07 op print $fh " | <a href='/search'>Search</a>";
119 38232a0a 2023-05-07 op print $fh "</p>\n";
120 38232a0a 2023-05-07 op
121 38232a0a 2023-05-07 op say $fh "<dl>";
122 38232a0a 2023-05-07 op foreach my $entry (@entries) {
123 38232a0a 2023-05-07 op my ($k, $v) = split /: /, $entry, 2;
124 38232a0a 2023-05-07 op chomp $v;
125 38232a0a 2023-05-07 op say $fh "<dt>$k:</dt><dd>$v</dd>";
126 38232a0a 2023-05-07 op }
127 38232a0a 2023-05-07 op say $fh "</dl>";
128 38232a0a 2023-05-07 op
129 38232a0a 2023-05-07 op say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
130 38232a0a 2023-05-07 op if defined $encmid;
131 38232a0a 2023-05-07 op
132 38232a0a 2023-05-07 op if (defined($p) and defined($n)) {
133 38232a0a 2023-05-07 op say $fh "<details>";
134 38232a0a 2023-05-07 op say $fh "<summary>Thread</summary>";
135 38232a0a 2023-05-07 op thrslice($fh, $mail, $p, $n);
136 38232a0a 2023-05-07 op say $fh "</details>";
137 38232a0a 2023-05-07 op thrnav($fh, $p, $n, $mail->{mid}, $mail->{tid});
138 38232a0a 2023-05-07 op }
139 38232a0a 2023-05-07 op
140 38232a0a 2023-05-07 op say $fh "</header>\n";
141 38232a0a 2023-05-07 op }
142 38232a0a 2023-05-07 op
143 38232a0a 2023-05-07 op sub threntry {
144 38232a0a 2023-05-07 op my ($fh, $type, $base, $last_level, $mail, $cur) = @_;
145 38232a0a 2023-05-07 op my $level = $mail->{level} - $base;
146 38232a0a 2023-05-07 op
147 38232a0a 2023-05-07 op say $fh "</ul></li>" x ($last_level - $level) if $last_level > $level;
148 38232a0a 2023-05-07 op say $fh "<li><ul>" if $last_level < $level;
149 38232a0a 2023-05-07 op
150 38232a0a 2023-05-07 op my $encmid = urlencode $mail->{mid};
151 38232a0a 2023-05-07 op
152 38232a0a 2023-05-07 op print $fh "<li id='$encmid' class='mail'>";
153 38232a0a 2023-05-07 op print $fh "<p class='mail-meta'>";
154 38232a0a 2023-05-07 op print $fh "<time>$mail->{date}</time> ";
155 38232a0a 2023-05-07 op print $fh "<span class='from'>$mail->{from}</span>";
156 38232a0a 2023-05-07 op print $fh "<span class='colon'>:</span>";
157 38232a0a 2023-05-07 op print $fh "</p>";
158 38232a0a 2023-05-07 op print $fh "<p class='subject'>";
159 38232a0a 2023-05-07 op
160 38232a0a 2023-05-07 op my $subj = $mail->{subj};
161 38232a0a 2023-05-07 op if (!defined($cur) || $mail->{mid} ne $cur->{mid}) {
162 38232a0a 2023-05-07 op print $fh "<a href='/$type/$encmid.html'>$subj</a>";
163 38232a0a 2023-05-07 op } else {
164 38232a0a 2023-05-07 op print $fh "<span>$subj</span>";
165 38232a0a 2023-05-07 op }
166 38232a0a 2023-05-07 op
167 38232a0a 2023-05-07 op print $fh "</p>";
168 38232a0a 2023-05-07 op print $fh "</li>";
169 38232a0a 2023-05-07 op
170 38232a0a 2023-05-07 op return $level;
171 38232a0a 2023-05-07 op }
172 38232a0a 2023-05-07 op
173 38232a0a 2023-05-07 op sub min_level {
174 38232a0a 2023-05-07 op my $l = 999;
175 38232a0a 2023-05-07 op return 0 unless @_;
176 38232a0a 2023-05-07 op for (@_) {
177 38232a0a 2023-05-07 op $l = $_->{level} if $_->{level} < $l;
178 38232a0a 2023-05-07 op }
179 38232a0a 2023-05-07 op return $l;
180 38232a0a 2023-05-07 op }
181 38232a0a 2023-05-07 op
182 38232a0a 2023-05-07 op sub thrslice {
183 38232a0a 2023-05-07 op my ($fh, $mail, $p, $n) = @_;
184 38232a0a 2023-05-07 op my @prev = @{$p};
185 38232a0a 2023-05-07 op my @next = @{$n};
186 38232a0a 2023-05-07 op my @thread = (@prev, $mail, @next);
187 38232a0a 2023-05-07 op return unless @thread;
188 38232a0a 2023-05-07 op my $base = min_level @thread;
189 38232a0a 2023-05-07 op my $level = 0;
190 38232a0a 2023-05-07 op print $fh "<div class='thread'>";
191 38232a0a 2023-05-07 op print $fh "<ul class='mails'>";
192 38232a0a 2023-05-07 op $level = threntry $fh, "mail", $base, $level, $_, $mail for @thread;
193 38232a0a 2023-05-07 op print $fh "</ul></li>" x $level;
194 38232a0a 2023-05-07 op print $fh "</ul></div>";
195 38232a0a 2023-05-07 op }
196 38232a0a 2023-05-07 op
197 38232a0a 2023-05-07 op sub thrnav {
198 38232a0a 2023-05-07 op my ($fh, $p, $n) = @_;
199 38232a0a 2023-05-07 op my @prev = @{$p};
200 38232a0a 2023-05-07 op my @next = @{$n};
201 38232a0a 2023-05-07 op
202 38232a0a 2023-05-07 op return if !@prev && !@next;
203 38232a0a 2023-05-07 op print $fh "<nav>";
204 38232a0a 2023-05-07 op
205 38232a0a 2023-05-07 op if (@prev) {
206 38232a0a 2023-05-07 op my $mail = $prev[-1];
207 38232a0a 2023-05-07 op my $encmid = $mail->{mid};
208 38232a0a 2023-05-07 op say $fh "<a href='/mail/$encmid.html'>Previous in thread</a>";
209 38232a0a 2023-05-07 op } else {
210 38232a0a 2023-05-07 op say $fh "<span>Previous in thread</span>";
211 38232a0a 2023-05-07 op }
212 38232a0a 2023-05-07 op
213 38232a0a 2023-05-07 op if (@next) {
214 38232a0a 2023-05-07 op my $mail = $next[0];
215 38232a0a 2023-05-07 op my $encmid = $mail->{mid};
216 38232a0a 2023-05-07 op say $fh "<a href='/mail/$encmid.html'>Next in thread</a>";
217 38232a0a 2023-05-07 op } else {
218 38232a0a 2023-05-07 op say $fh "<span>Next in thread</span>";
219 38232a0a 2023-05-07 op }
220 38232a0a 2023-05-07 op
221 38232a0a 2023-05-07 op print $fh "</nav>";
222 38232a0a 2023-05-07 op }
223 38232a0a 2023-05-07 op
224 38232a0a 2023-05-07 op 1;