1 #!/usr/bin/env perl
2 
3 use open ":std", ":encoding(UTF-8)";
4 use utf8;
5 use strict;
6 use warnings;
7 use v5.32;
8 
9 my $outdir = $ENV{'OUTDIR'};
10 die 'Set $OUTDIR' unless defined $outdir;
11 mkdir $outdir;
12 
13 my $tfh;
14 my $threads_seen = 0;
15 my $last_level = 0;
16 
17 my $logo = <<EOF;
18 <img srcset='/got-tiny.png, /got-tiny@2x.png 2x'
19      src='/got-tiny.png'
20      alt='"GOT", but the "O" is a cute, smiling sun' />
21 EOF
22 
23 sub san {
24 	my $str = shift;
25 	$str =~ s/&/\&amp;/g;
26 	$str =~ s/</\&lt;/g;
27 	$str =~ s/>/\&gt;/g;
28 	return $str;
29 }
30 
31 sub initpage {
32 	my ($fh, $title) = @_;
33 	open(my $hdr, '<', 'head.html')
34 	    or die "can't open head.html: $!";
35 	while (<$hdr>) {
36 		s/TITLE/$title/;
37 		print $fh $_;
38 	}
39 }
40 
41 sub endpage {
42 	my $fh = shift;
43 	open(my $foot, '<', 'foot.html')
44 	    or die "can't open foot.html: $!";
45 	print $fh $_ while <$foot>;
46 }
47 
48 sub nextthread {
49 	endthread() if defined($tfh);
50 	my ($mid, $subj) = @_;
51 	my $dest = "$outdir/thread/$mid.html";
52 	open($tfh, '>', $dest) or die "can't open $dest: $!";
53 	initpage($tfh, $subj);
54 
55 	print $tfh "<header class='mail-header'>";
56 	print $tfh "<p>";
57 	print $tfh $logo;
58 	print $tfh "<a href='/'>‹ Back to the index</a>";
59 	print $tfh "</p>";
60 	print $tfh "<dl><dt>Thread:</dt><dd>$subj</dd></dl>";
61 	print $tfh "</header>\n";
62 	# print $tfh "<div class='thread'><ul class='mails'>\n";
63 }
64 
65 sub endthread {
66 	say $tfh "</ul></li>" x $last_level;
67 	say $tfh "</ul></div>\n";
68 	endpage($tfh);
69 	close($tfh);
70 
71 	$last_level = 0;
72 }
73 
74 sub entry_raw {
75 	my ($fh, $sep, $mid, $level, $date, $from, $subj) = @_;
76 	my $new_thread = $level == 0;
77 
78 	say $fh "</ul>\n</li>" x ($last_level - $level) if $last_level > $level;
79 	say $fh "</ul>\n</div>$sep" if $threads_seen && $new_thread;
80 
81 	if ($new_thread) {
82 		nextthread($mid, $subj);
83 		say $fh "<div class='thread'>";
84 	}
85 
86 	if ($last_level < $level) {
87 		say $fh "<li>\n<ul>";
88 	} elsif ($last_level == 0) {
89 		say $fh "<ul class='mails'>";
90 	}
91 
92 	print $fh "<li id='$mid' class='mail'>";
93 	print $fh "<p class='mail-meta'>";
94 	print $fh "<time>$date</time> ";
95 	print $fh "<span class='from'>$from</span>";
96 	print $fh "<span class='colon'>:</span>";
97 	if ($fh != $tfh && $level == 0) {
98 		print $fh " (<a href='/thread/$mid.html'>thread</a>)";
99 	}
100 	print $fh "</p>";
101 	print $fh "<p class='subject'>";
102 	print $fh "<a href='/$mid.html'>$subj</a>";
103 	print $fh "</p>";
104 	print $fh "</li>\n";
105 }
106 
107 sub entry {
108 	entry_raw(\*STDOUT, "<hr />", @_);
109 	entry_raw($tfh, "", @_);
110 }
111 
112 initpage(\*STDOUT, "Game of Trees Mail Archive");
113 print <<EOF;
114 <header class='index-header'>
115   <a href="https://gameoftrees.org" target="_blank">
116     <img src='/got.png'
117          srcset='/got.png, /got@2x.png 2x'
118          alt='"GOT" where the "O" is a cute smiling sun.' />
119   </a>
120   <h1>Game of Trees Mail Archive</h1>
121 </header>
122 <main>
123 EOF
124 
125 while (<>) {
126 	chomp;
127 	m/^[^ ]+ <([^>]+)> (.+)(\d{4}-\d{2}-\d{2} \d{2}:\d{2}) <([^>]+)> (.*)/;
128 	die "woops; $_\n" unless defined $1;
129 
130 	my ($mid, $indent, $date, $from, $subj) = ($1, $2, $3, $4, $5);
131 	$from =~ s/\s+$//;
132 	$from = san($from);
133 	$subj = san($subj);
134 
135 	my $level = length($indent) - 1;
136 	$level = 10 if $indent =~ m/\.\.\d{2}\.\./;
137 
138 	$mid =~ s,_,__,g;
139 	$mid =~ s,/,_,g;
140 
141 	$subj =~ s/\s+/ /g;
142 	$subj =~ s/\s+$//g;
143 
144 	entry($mid, $level, $date, $from, $subj);
145 	$last_level = $level;
146 	$threads_seen = 1;
147 }
148 
149 if ($threads_seen) {
150 	say "</ul></li>" x $last_level;
151 	say "</ul></div>";
152 	endthread();
153 }
154 
155 say "</main>";
156 endpage(\*STDOUT);