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