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