Blame
Date:
Tue Aug 30 13:28:10 2022 UTC
Message:
use (part) of the original file name instead of the message-id
001
2022-08-29
op
# GotMArc was written by Omar Polo <op@openbsd.org> and is placed in
002
2022-08-29
op
# the public domain. The author hereby disclaims copyright to this
003
2022-08-29
op
# source code.
004
2022-08-29
op
005
2022-08-25
op
package GotMArc;
006
2022-08-25
op
use strict;
007
2022-08-25
op
use warnings;
008
2022-08-25
op
use v5.32;
009
2022-08-25
op
use Exporter;
010
2022-08-30
op
use File::Basename;
011
2022-08-25
op
012
2022-08-25
op
our @ISA = qw(Exporter);
013
2022-08-30
op
our @EXPORT_OK = qw(san urlencode parse initpage endpage index_header thread_header);
014
2022-08-25
op
015
2022-08-25
op
sub san {
016
2022-08-25
op
my $str = shift;
017
2022-08-25
op
$str =~ s/&/\&amp;/g;
018
2022-08-25
op
$str =~ s/</\&lt;/g;
019
2022-08-25
op
$str =~ s/>/\&gt;/g;
020
2022-08-25
op
return $str;
021
2022-08-25
op
}
022
2022-08-25
op
023
2022-08-30
op
sub urlencode {
024
2022-08-30
op
my $str = shift;
025
2022-08-30
op
unless (defined($str)) {
026
2022-08-30
op
my ($pkg, $file, $line) = caller 1;
027
2022-08-30
op
die "bad $pkg / $file:$line";
028
2022-08-30
op
}
029
2022-08-30
op
$str =~ s/([^-_~.A-Za-z0-9])/sprintf("%%%2X", ord($1))/ge;
030
2022-08-30
op
return $str;
031
2022-08-30
op
}
032
2022-08-30
op
033
2022-08-26
op
sub ssan {
034
2022-08-26
op
my $str = shift;
035
2022-08-26
op
$str =~ s/\s+/ /g;
036
2022-08-26
op
$str =~ s/\s+$//;
037
2022-08-26
op
return san($str);
038
2022-08-26
op
}
039
2022-08-26
op
040
2022-08-26
op
sub parse {
041
2022-08-30
op
my ($indent, $fname, $date, $from, $subj) = m{
042
2022-08-26
op
^([^-]*)- # the indent level
043
2022-08-26
op
([^ ]+)\s # filename
044
2022-08-26
op
(\d{4}-\d\d-\d\d[ ]\d\d:\d\d) # date
045
2022-08-26
op
<([^>]+)> # from
046
2022-08-26
op
(.*) # subject
047
2022-08-26
op
}x or die "can't parse: $_";
048
2022-08-26
op
049
2022-08-26
op
my $level = length($indent);
050
2022-08-26
op
$level = 10 if $indent =~ m/\.\.\d+\.\./;
051
2022-08-26
op
052
2022-08-26
op
$from = ssan($from);
053
2022-08-26
op
$subj = ssan($subj);
054
2022-08-26
op
055
2022-08-30
op
my ($time, $id) = split /\./, basename($fname);
056
2022-08-30
op
my $mid = "$time.$id";
057
2022-08-30
op
058
2022-08-26
op
return ($level, $fname, $mid, $date, $from, $subj);
059
2022-08-26
op
}
060
2022-08-26
op
061
2022-08-27
op
sub readall {
062
2022-08-27
op
my $path = shift;
063
2022-08-25
op
local $/ = undef;
064
2022-08-27
op
open my $fh, "<", $path or die "can't open $path: $!";
065
2022-08-25
op
<$fh>;
066
2022-08-27
op
}
067
2022-08-25
op
068
2022-08-27
op
my $small_logo = readall "logo-small.html";
069
2022-08-27
op
my $hdr = readall "head.html";
070
2022-08-27
op
my $foot = readall "foot.html";
071
2022-08-27
op
my $idxhdr = readall "index-header.html";
072
2022-08-27
op
073
2022-08-25
op
sub initpage {
074
2022-08-25
op
my ($fh, $title) = @_;
075
2022-08-25
op
say $fh $hdr =~ s/TITLE/$title/r;
076
2022-08-25
op
}
077
2022-08-25
op
078
2022-08-25
op
sub endpage {
079
2022-08-25
op
my $fh = shift;
080
2022-08-25
op
say $fh $foot;
081
2022-08-25
op
}
082
2022-08-25
op
083
2022-08-27
op
sub index_header {
084
2022-08-27
op
my ($fh, $page, $subtitle) = @_;
085
2022-08-27
op
my $html = $idxhdr =~ s/PAGE/$page/r;
086
2022-08-27
op
$html =~ s/SUBTITLE/$subtitle/;
087
2022-08-27
op
print $fh $html;
088
2022-08-27
op
}
089
2022-08-27
op
090
2022-08-27
op
sub thread_header {
091
2022-08-27
op
my ($fh, $tid, $mid, $e) = @_;
092
2022-08-27
op
my @entries = @$e;
093
2022-08-27
op
094
2022-08-30
op
my $enctid = urlencode $tid if defined $tid;
095
2022-08-30
op
my $encmid = urlencode $mid if defined $mid;
096
2022-08-30
op
097
2022-08-27
op
print $fh "<header class='mail-header'>\n";
098
2022-08-27
op
099
2022-08-27
op
print $fh "<p>";
100
2022-08-27
op
print $fh $small_logo;
101
2022-08-27
op
print $fh "<a href='/'>Index</a>";
102
2022-08-30
op
print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
103
2022-08-30
op
if defined $enctid;
104
2022-08-27
op
print $fh "</p>\n";
105
2022-08-27
op
106
2022-08-27
op
say $fh "<dl>";
107
2022-08-27
op
foreach my $entry (@entries) {
108
2022-08-27
op
my ($k, $v) = split /: /, $entry, 2;
109
2022-08-27
op
chomp $v;
110
2022-08-27
op
say $fh "<dt>$k:</dt><dd>$v</dd>";
111
2022-08-27
op
}
112
2022-08-27
op
say $fh "</dl>";
113
2022-08-27
op
114
2022-08-30
op
say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
115
2022-08-30
op
if defined $encmid;
116
2022-08-27
op
117
2022-08-27
op
say $fh "</header>\n";
118
2022-08-27
op
};
119
2022-08-27
op
120
2022-08-25
op
1;
Omar Polo