Blame


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