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