1
package GotMArc;
2
use strict;
3
use warnings;
4
use v5.32;
5
use Exporter;
6

7
our @ISA = qw(Exporter);
8
our @EXPORT_OK = qw(san parse initpage endpage index_header thread_header);
9

10
sub san {
11
	my $str = shift;
12
	$str =~ s/&/\&/g;
13
	$str =~ s/</\&lt;/g;
14
	$str =~ s/>/\&gt;/g;
15
	return $str;
16
}
17

18
sub ssan {
19
	my $str = shift;
20
	$str =~ s/\s+/ /g;
21
	$str =~ s/\s+$//;
22
	return san($str);
23
}
24

25
sub mid2path {
26
	my $mid = shift;
27
	$mid =~ s,_,__,g;
28
	$mid =~ s,/,_,g;
29
	return $mid;
30
}
31

32
sub parse {
33
	my ($indent, $fname, $mid, $date, $from, $subj) = m{
34
		^([^-]*)-			# the indent level
35
		([^ ]+)\s			# filename
36
		<([^>]+)>			# message id
37
		(\d{4}-\d\d-\d\d[ ]\d\d:\d\d)	# date
38
		<([^>]+)>			# from
39
		(.*)				# subject
40
	}x or die "can't parse: $_";
41

42
	my $level = length($indent);
43
	$level = 10 if $indent =~ m/\.\.\d+\.\./;
44

45
	$mid = mid2path($mid);
46
	$from = ssan($from);
47
	$subj = ssan($subj);
48

49
	return ($level, $fname, $mid, $date, $from, $subj);
50
}
51

52
sub readall {
53
	my $path = shift;
54
	local $/ = undef;
55
	open my $fh, "<", $path or die "can't open $path: $!";
56
	<$fh>;
57
}
58

59
my $small_logo = readall "logo-small.html";
60
my $hdr = readall "head.html";
61
my $foot = readall "foot.html";
62
my $idxhdr = readall "index-header.html";
63

64
sub initpage {
65
	my ($fh, $title) = @_;
66
	say $fh $hdr =~ s/TITLE/$title/r;
67
}
68

69
sub endpage {
70
	my $fh = shift;
71
	say $fh $foot;
72
}
73

74
sub index_header {
75
	my ($fh, $page, $subtitle) = @_;
76
	my $html = $idxhdr =~ s/PAGE/$page/r;
77
	$html =~ s/SUBTITLE/$subtitle/;
78
	print $fh $html;
79
}
80

81
sub thread_header {
82
	my ($fh, $tid, $mid, $e) = @_;
83
	my @entries = @$e;
84

85
	print $fh "<header class='mail-header'>\n";
86

87
	print $fh "<p>";
88
	print $fh $small_logo;
89
	print $fh "<a href='/'>Index</a>";
90
	print $fh " | <a href='/thread/$tid.html#$mid'>Thread</a>"
91
	    if defined $tid;
92
	print $fh "</p>\n";
93

94
	say $fh "<dl>";
95
	foreach my $entry (@entries) {
96
		my ($k, $v) = split /: /, $entry, 2;
97
		chomp $v;
98
		say $fh "<dt>$k:</dt><dd>$v</dd>";
99
	}
100
	say $fh "</dl>";
101

102
	say $fh "<p>Download raw <a href='/text/$mid.txt'>body</a>.</p>"
103
	    if defined $mid;
104

105
	say $fh "</header>\n";
106
};
107

108
1;