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