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
  3 1bcb9899 2022-08-29 op # source code.
  4 1bcb9899 2022-08-29 op 
  5 04eab9af 2022-08-25 op package GotMArc;
  6 04eab9af 2022-08-25 op use strict;
  7 04eab9af 2022-08-25 op use warnings;
  8 04eab9af 2022-08-25 op use v5.32;
  9 04eab9af 2022-08-25 op use Exporter;
 10 8a090a17 2022-08-30 op use File::Basename;
 11 04eab9af 2022-08-25 op 
 12 04eab9af 2022-08-25 op our @ISA = qw(Exporter);
 13 f0fb0f08 2022-08-30 op our @EXPORT_OK = qw(san urlencode parse initpage endpage index_header thread_header);
 14 04eab9af 2022-08-25 op 
 15 04eab9af 2022-08-25 op sub san {
 16 04eab9af 2022-08-25 op 	my $str = shift;
 17 04eab9af 2022-08-25 op 	$str =~ s/&/\&amp;/g;
 18 04eab9af 2022-08-25 op 	$str =~ s/</\&lt;/g;
 19 04eab9af 2022-08-25 op 	$str =~ s/>/\&gt;/g;
 20 04eab9af 2022-08-25 op 	return $str;
 21 04eab9af 2022-08-25 op }
 22 04eab9af 2022-08-25 op 
 23 f0fb0f08 2022-08-30 op sub urlencode {
 24 f0fb0f08 2022-08-30 op 	my $str = shift;
 25 f0fb0f08 2022-08-30 op 	unless (defined($str)) {
 26 f0fb0f08 2022-08-30 op 		my ($pkg, $file, $line) = caller 1;
 27 f0fb0f08 2022-08-30 op 		die "bad $pkg / $file:$line";
 28 f0fb0f08 2022-08-30 op 	}
 29 f0fb0f08 2022-08-30 op 	$str =~ s/([^-_~.A-Za-z0-9])/sprintf("%%%2X", ord($1))/ge;
 30 f0fb0f08 2022-08-30 op 	return $str;
 31 f0fb0f08 2022-08-30 op }
 32 f0fb0f08 2022-08-30 op 
 33 de557185 2022-08-26 op sub ssan {
 34 de557185 2022-08-26 op 	my $str = shift;
 35 de557185 2022-08-26 op 	$str =~ s/\s+/ /g;
 36 de557185 2022-08-26 op 	$str =~ s/\s+$//;
 37 de557185 2022-08-26 op 	return san($str);
 38 de557185 2022-08-26 op }
 39 de557185 2022-08-26 op 
 40 de557185 2022-08-26 op sub parse {
 41 8a090a17 2022-08-30 op 	my ($indent, $fname, $date, $from, $subj) = m{
 42 de557185 2022-08-26 op 		^([^-]*)-			# the indent level
 43 de557185 2022-08-26 op 		([^ ]+)\s			# filename
 44 de557185 2022-08-26 op 		(\d{4}-\d\d-\d\d[ ]\d\d:\d\d)	# date
 45 de557185 2022-08-26 op 		<([^>]+)>			# from
 46 de557185 2022-08-26 op 		(.*)				# subject
 47 de557185 2022-08-26 op 	}x or die "can't parse: $_";
 48 de557185 2022-08-26 op 
 49 de557185 2022-08-26 op 	my $level = length($indent);
 50 de557185 2022-08-26 op 	$level = 10 if $indent =~ m/\.\.\d+\.\./;
 51 de557185 2022-08-26 op 
 52 de557185 2022-08-26 op 	$from = ssan($from);
 53 de557185 2022-08-26 op 	$subj = ssan($subj);
 54 de557185 2022-08-26 op 
 55 8a090a17 2022-08-30 op 	my ($time, $id) = split /\./, basename($fname);
 56 8a090a17 2022-08-30 op 	my $mid = "$time.$id";
 57 8a090a17 2022-08-30 op 
 58 bbdbef1a 2023-04-01 op 	return {level => $level, fname => $fname,
 59 bbdbef1a 2023-04-01 op 	    mid => $mid, date => $date, from => $from, subj => $subj};
 60 de557185 2022-08-26 op }
 61 de557185 2022-08-26 op 
 62 4ad24540 2022-08-27 op sub readall {
 63 4ad24540 2022-08-27 op 	my $path = shift;
 64 04eab9af 2022-08-25 op 	local $/ = undef;
 65 4ad24540 2022-08-27 op 	open my $fh, "<", $path or die "can't open $path: $!";
 66 04eab9af 2022-08-25 op 	<$fh>;
 67 4ad24540 2022-08-27 op }
 68 04eab9af 2022-08-25 op 
 69 4ad24540 2022-08-27 op my $small_logo = readall "logo-small.html";
 70 4ad24540 2022-08-27 op my $hdr = readall "head.html";
 71 4ad24540 2022-08-27 op my $foot = readall "foot.html";
 72 9ec6c848 2022-08-27 op my $idxhdr = readall "index-header.html";
 73 4ad24540 2022-08-27 op 
 74 04eab9af 2022-08-25 op sub initpage {
 75 04eab9af 2022-08-25 op 	my ($fh, $title) = @_;
 76 04eab9af 2022-08-25 op 	say $fh $hdr =~ s/TITLE/$title/r;
 77 04eab9af 2022-08-25 op }
 78 04eab9af 2022-08-25 op 
 79 04eab9af 2022-08-25 op sub endpage {
 80 04eab9af 2022-08-25 op 	my $fh = shift;
 81 04eab9af 2022-08-25 op 	say $fh $foot;
 82 04eab9af 2022-08-25 op }
 83 04eab9af 2022-08-25 op 
 84 9ec6c848 2022-08-27 op sub index_header {
 85 9ec6c848 2022-08-27 op 	my ($fh, $page, $subtitle) = @_;
 86 9ec6c848 2022-08-27 op 	my $html = $idxhdr =~ s/PAGE/$page/r;
 87 9ec6c848 2022-08-27 op 	$html =~ s/SUBTITLE/$subtitle/;
 88 9ec6c848 2022-08-27 op 	print $fh $html;
 89 9ec6c848 2022-08-27 op }
 90 9ec6c848 2022-08-27 op 
 91 9d8482ab 2022-08-27 op sub thread_header {
 92 9d8482ab 2022-08-27 op 	my ($fh, $tid, $mid, $e) = @_;
 93 9d8482ab 2022-08-27 op 	my @entries = @$e;
 94 9d8482ab 2022-08-27 op 
 95 f0fb0f08 2022-08-30 op 	my $enctid = urlencode $tid if defined $tid;
 96 f0fb0f08 2022-08-30 op 	my $encmid = urlencode $mid if defined $mid;
 97 f0fb0f08 2022-08-30 op 
 98 9d8482ab 2022-08-27 op 	print $fh "<header class='mail-header'>\n";
 99 9d8482ab 2022-08-27 op 
100 9d8482ab 2022-08-27 op 	print $fh "<p>";
101 9d8482ab 2022-08-27 op 	print $fh $small_logo;
102 9d8482ab 2022-08-27 op 	print $fh "<a href='/'>Index</a>";
103 f0fb0f08 2022-08-30 op 	print $fh " | <a href='/thread/$enctid.html#$encmid'>Thread</a>"
104 f0fb0f08 2022-08-30 op 	    if defined $enctid;
105 9d8482ab 2022-08-27 op 	print $fh "</p>\n";
106 9d8482ab 2022-08-27 op 
107 9d8482ab 2022-08-27 op 	say $fh "<dl>";
108 9d8482ab 2022-08-27 op 	foreach my $entry (@entries) {
109 de498c0c 2022-08-27 op 		my ($k, $v) = split /: /, $entry, 2;
110 de498c0c 2022-08-27 op 		chomp $v;
111 9d8482ab 2022-08-27 op 		say $fh "<dt>$k:</dt><dd>$v</dd>";
112 9d8482ab 2022-08-27 op 	}
113 9d8482ab 2022-08-27 op 	say $fh "</dl>";
114 9d8482ab 2022-08-27 op 
115 f0fb0f08 2022-08-30 op 	say $fh "<p>Download raw <a href='/text/$encmid.txt'>body</a>.</p>"
116 f0fb0f08 2022-08-30 op 	    if defined $encmid;
117 9d8482ab 2022-08-27 op 
118 9d8482ab 2022-08-27 op 	say $fh "</header>\n";
119 9d8482ab 2022-08-27 op };
120 9d8482ab 2022-08-27 op 
121 04eab9af 2022-08-25 op 1;