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 GotMArc;
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 thread_header);
14 
15 sub san {
16 	my $str = shift;
17 	$str =~ s/&/\&amp;/g;
18 	$str =~ s/</\&lt;/g;
19 	$str =~ s/>/\&gt;/g;
20 	return $str;
21 }
22 
23 sub urlencode {
24 	my $str = shift;
25 	unless (defined($str)) {
26 		my ($pkg, $file, $line) = caller 1;
27 		die "bad $pkg / $file:$line";
28 	}
29 	$str =~ s/([^-_~.A-Za-z0-9])/sprintf("%%%2X", ord($1))/ge;
30 	return $str;
31 }
32 
33 sub ssan {
34 	my $str = shift;
35 	$str =~ s/\s+/ /g;
36 	$str =~ s/\s+$//;
37 	return san($str);
38 }
39 
40 sub parse {
41 	my $line = shift;
42 	my ($indent, $fname, $date, $from, $subj) = $line =~ m{
43 		^([^-]*)-			# the indent level
44 		([^ ]+)\s			# filename
45 		(\d{4}-\d\d-\d\d[ ]\d\d:\d\d)	# date
46 		<([^>]+)>			# from
47 		(.*)				# subject
48 	}x or die "can't parse: $line";
49 
50 	my $level = length($indent);
51 	$level = 10 if $indent =~ m/\.\.\d+\.\./;
52 
53 	$from = ssan($from);
54 	$subj = ssan($subj);
55 
56 	my ($time, $id) = split /\./, basename($fname);
57 	my $mid = "$time.$id";
58 
59 	return {level => $level, fname => $fname,
60 	    mid => $mid, date => $date, from => $from, subj => $subj};
61 }
62 
63 sub readall {
64 	my $path = shift;
65 	local $/ = undef;
66 	open my $fh, "<", $path or die "can't open $path: $!";
67 	<$fh>;
68 }
69 
70 my $small_logo = readall "logo-small.html";
71 my $hdr = readall "head.html";
72 my $foot = readall "foot.html";
73 my $idxhdr = readall "index-header.html";
74 
75 sub initpage {
76 	my ($fh, $title) = @_;
77 	say $fh $hdr =~ s/TITLE/$title/r;
78 }
79 
80 sub endpage {
81 	my $fh = shift;
82 	say $fh $foot;
83 }
84 
85 sub index_header {
86 	my ($fh, $page, $subtitle) = @_;
87 	my $html = $idxhdr =~ s/PAGE/$page/r;
88 	$html =~ s/SUBTITLE/$subtitle/;
89 	print $fh $html;
90 }
91 
92 sub thread_header {
93 	my ($fh, $tid, $mid, $e) = @_;
94 	my @entries = @$e;
95 
96 	my $enctid = urlencode $tid if defined $tid;
97 	my $encmid = urlencode $mid if defined $mid;
98 
99 	print $fh "<header class='mail-header'>\n";
100 
101 	print $fh "<p>";
102 	print $fh $small_logo;
103 	print $fh "<a href='/'>Index</a>";
104 	print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
105 	    if defined $enctid;
106 	print $fh "</p>\n";
107 
108 	say $fh "<dl>";
109 	foreach my $entry (@entries) {
110 		my ($k, $v) = split /: /, $entry, 2;
111 		chomp $v;
112 		say $fh "<dt>$k:</dt><dd>$v</dd>";
113 	}
114 	say $fh "</dl>";
115 
116 	say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
117 	    if defined $encmid;
118 
119 	say $fh "</header>\n";
120 };
121 
122 1;