1 1bcb9899 2022-08-29 op # GotMArc was written by Omar Polo <op@openbsd.org> and is placed in
2 1bcb9899 2022-08-29 op # the public domain. The author hereby disclaims copyright to this
5 04eab9af 2022-08-25 op package GotMArc;
10 8a090a17 2022-08-30 op use File::Basename;
12 04eab9af 2022-08-25 op our @ISA = qw(Exporter);
13 bd3babdf 2023-04-02 op our @EXPORT_OK = qw(san urlencode parse initpage endpage index_header
14 bd3babdf 2023-04-02 op thread_header threntry);
17 04eab9af 2022-08-25 op my $str = shift;
18 04eab9af 2022-08-25 op $str =~ s/&/\&/g;
19 04eab9af 2022-08-25 op $str =~ s/</\</g;
20 04eab9af 2022-08-25 op $str =~ s/>/\>/g;
24 f0fb0f08 2022-08-30 op sub urlencode {
25 f0fb0f08 2022-08-30 op my $str = shift;
26 f0fb0f08 2022-08-30 op unless (defined($str)) {
27 f0fb0f08 2022-08-30 op my ($pkg, $file, $line) = caller 1;
28 f0fb0f08 2022-08-30 op die "bad $pkg / $file:$line";
30 f0fb0f08 2022-08-30 op $str =~ s/([^-_~.A-Za-z0-9])/sprintf("%%%2X", ord($1))/ge;
35 de557185 2022-08-26 op my $str = shift;
36 de557185 2022-08-26 op $str =~ s/\s+/ /g;
37 de557185 2022-08-26 op $str =~ s/\s+$//;
38 de557185 2022-08-26 op return san($str);
42 6b36ff28 2023-04-01 op my $line = shift;
43 6b36ff28 2023-04-01 op my ($indent, $fname, $date, $from, $subj) = $line =~ m{
44 de557185 2022-08-26 op ^([^-]*)- # the indent level
45 de557185 2022-08-26 op ([^ ]+)\s # filename
46 de557185 2022-08-26 op (\d{4}-\d\d-\d\d[ ]\d\d:\d\d) # date
47 de557185 2022-08-26 op <([^>]+)> # from
48 de557185 2022-08-26 op (.*) # subject
49 6b36ff28 2023-04-01 op }x or die "can't parse: $line";
51 de557185 2022-08-26 op my $level = length($indent);
52 de557185 2022-08-26 op $level = 10 if $indent =~ m/\.\.\d+\.\./;
54 de557185 2022-08-26 op $from = ssan($from);
55 de557185 2022-08-26 op $subj = ssan($subj);
57 8a090a17 2022-08-30 op my ($time, $id) = split /\./, basename($fname);
58 8a090a17 2022-08-30 op my $mid = "$time.$id";
60 bbdbef1a 2023-04-01 op return {level => $level, fname => $fname,
61 bbdbef1a 2023-04-01 op mid => $mid, date => $date, from => $from, subj => $subj};
65 4ad24540 2022-08-27 op my $path = shift;
66 04eab9af 2022-08-25 op local $/ = undef;
67 4ad24540 2022-08-27 op open my $fh, "<", $path or die "can't open $path: $!";
71 4ad24540 2022-08-27 op my $small_logo = readall "logo-small.html";
72 4ad24540 2022-08-27 op my $hdr = readall "head.html";
73 4ad24540 2022-08-27 op my $foot = readall "foot.html";
74 9ec6c848 2022-08-27 op my $idxhdr = readall "index-header.html";
76 04eab9af 2022-08-25 op sub initpage {
77 04eab9af 2022-08-25 op my ($fh, $title) = @_;
78 04eab9af 2022-08-25 op say $fh $hdr =~ s/TITLE/$title/r;
82 04eab9af 2022-08-25 op my $fh = shift;
83 04eab9af 2022-08-25 op say $fh $foot;
86 9ec6c848 2022-08-27 op sub index_header {
87 9ec6c848 2022-08-27 op my ($fh, $page, $subtitle) = @_;
88 9ec6c848 2022-08-27 op my $html = $idxhdr =~ s/PAGE/$page/r;
89 9ec6c848 2022-08-27 op $html =~ s/SUBTITLE/$subtitle/;
90 9ec6c848 2022-08-27 op print $fh $html;
93 9d8482ab 2022-08-27 op sub thread_header {
94 9d8482ab 2022-08-27 op my ($fh, $tid, $mid, $e) = @_;
95 9d8482ab 2022-08-27 op my @entries = @$e;
97 f0fb0f08 2022-08-30 op my $enctid = urlencode $tid if defined $tid;
98 f0fb0f08 2022-08-30 op my $encmid = urlencode $mid if defined $mid;
100 9d8482ab 2022-08-27 op print $fh "<header class='mail-header'>\n";
102 9d8482ab 2022-08-27 op print $fh "<p>";
103 9d8482ab 2022-08-27 op print $fh $small_logo;
104 9d8482ab 2022-08-27 op print $fh "<a href='/'>Index</a>";
105 f0fb0f08 2022-08-30 op print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
106 f0fb0f08 2022-08-30 op if defined $enctid;
107 9d8482ab 2022-08-27 op print $fh "</p>\n";
109 9d8482ab 2022-08-27 op say $fh "<dl>";
110 9d8482ab 2022-08-27 op foreach my $entry (@entries) {
111 de498c0c 2022-08-27 op my ($k, $v) = split /: /, $entry, 2;
113 9d8482ab 2022-08-27 op say $fh "<dt>$k:</dt><dd>$v</dd>";
115 9d8482ab 2022-08-27 op say $fh "</dl>";
117 f0fb0f08 2022-08-30 op say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
118 f0fb0f08 2022-08-30 op if defined $encmid;
120 9d8482ab 2022-08-27 op say $fh "</header>\n";
123 bd3babdf 2023-04-02 op sub threntry {
124 bd3babdf 2023-04-02 op my ($fh, $type, $base, $last_level, $mail, $cur) = @_;
125 bd3babdf 2023-04-02 op my $level = $mail->{level} - $base;
127 bd3babdf 2023-04-02 op say $fh "</ul></li>" x ($last_level - $level) if $last_level > $level;
128 bd3babdf 2023-04-02 op say $fh "<li><ul>" if $last_level < $level;
130 bd3babdf 2023-04-02 op my $encmid = urlencode $mail->{mid};
132 bd3babdf 2023-04-02 op print $fh "<li id='$encmid' class='mail'>";
133 bd3babdf 2023-04-02 op print $fh "<p class='mail-meta'>";
134 bd3babdf 2023-04-02 op print $fh "<time>$mail->{date}</time> ";
135 bd3babdf 2023-04-02 op print $fh "<span class='from'>$mail->{from}</span>";
136 bd3babdf 2023-04-02 op print $fh "<span class='colon'>:</span>";
137 bd3babdf 2023-04-02 op print $fh "</p>";
138 bd3babdf 2023-04-02 op print $fh "<p class='subject'>";
140 bd3babdf 2023-04-02 op my $subj = $mail->{subj};
141 bd3babdf 2023-04-02 op if (!defined($cur) || $mail->{mid} ne $cur->{mid}) {
142 bd3babdf 2023-04-02 op print $fh "<a href='/$type/$encmid.html'>$subj</a>";
144 bd3babdf 2023-04-02 op print $fh "<span>$subj</span>";
147 bd3babdf 2023-04-02 op print $fh "</p>";
148 bd3babdf 2023-04-02 op print $fh "</li>";
150 bd3babdf 2023-04-02 op return $level;
