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 ($indent, $fname, $date, $from, $subj) = m{
42
		^([^-]*)-			# the indent level
43
		([^ ]+)\s			# filename
44
		(\d{4}-\d\d-\d\d[ ]\d\d:\d\d)	# date
45
		<([^>]+)>			# from
46
		(.*)				# subject
47
	}x or die "can't parse: $_";
48

49
	my $level = length($indent);
50
	$level = 10 if $indent =~ m/\.\.\d+\.\./;
51

52
	$from = ssan($from);
53
	$subj = ssan($subj);
54

55
	my ($time, $id) = split /\./, basename($fname);
56
	my $mid = "$time.$id";
57

58
	return ($level, $fname, $mid, $date, $from, $subj);
59
}
60

61
sub readall {
62
	my $path = shift;
63
	local $/ = undef;
64
	open my $fh, "<", $path or die "can't open $path: $!";
65
	<$fh>;
66
}
67

68
my $small_logo = readall "logo-small.html";
69
my $hdr = readall "head.html";
70
my $foot = readall "foot.html";
71
my $idxhdr = readall "index-header.html";
72

73
sub initpage {
74
	my ($fh, $title) = @_;
75
	say $fh $hdr =~ s/TITLE/$title/r;
76
}
77

78
sub endpage {
79
	my $fh = shift;
80
	say $fh $foot;
81
}
82

83
sub index_header {
84
	my ($fh, $page, $subtitle) = @_;
85
	my $html = $idxhdr =~ s/PAGE/$page/r;
86
	$html =~ s/SUBTITLE/$subtitle/;
87
	print $fh $html;
88
}
89

90
sub thread_header {
91
	my ($fh, $tid, $mid, $e) = @_;
92
	my @entries = @$e;
93

94
	my $enctid = urlencode $tid if defined $tid;
95
	my $encmid = urlencode $mid if defined $mid;
96

97
	print $fh "<header class='mail-header'>\n";
98

99
	print $fh "<p>";
100
	print $fh $small_logo;
101
	print $fh "<a href='/'>Index</a>";
102
	print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
103
	    if defined $enctid;
104
	print $fh "</p>\n";
105

106
	say $fh "<dl>";
107
	foreach my $entry (@entries) {
108
		my ($k, $v) = split /: /, $entry, 2;
109
		chomp $v;
110
		say $fh "<dt>$k:</dt><dd>$v</dd>";
111
	}
112
	say $fh "</dl>";
113

114
	say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
115
	    if defined $encmid;
116

117
	say $fh "</header>\n";
118
};
119

120
1;