tsunami  Artifact [aa8b31b797]

Artifact aa8b31b79762f48b203018f5c48015223b0438cce9d156eaca79f91d2ba8eb54:


#!/usr/bin/perl
use warnings;
use feature "unicode_strings";
use utf8;
binmode STDOUT, ':utf8';

sub err { print "\e[1;31merror:\e[0m ".$_[0]."\n"; exit 1; }
if (! -e "pub.pl") {
	err "\e[1mpub.pl\e[0m must be run from the directory it lives in";
}

sub filext {
	my $name = shift;
	my $ext = $name;
	$ext =~ s/^([^.]*\.)*//;
	if ($ext eq $name) {
		return "";
	} else {
		return $ext;
	}
}
sub basename {
	my $name = shift;
	$name =~ s/\.[^.]*$//;
	return $name;
}

sub isws { my $c = shift;
	return (($c eq " ") or ($c eq "\t"));
}

sub readconf {
	my $filename = shift;
	open my $fd, "<:encoding(UTF-8)", "cfg/".$filename
		or err "could not open $filename ($!)\nmake sure it exists";
	my @lines;
	while (my $ln = <$fd>) {
		chomp $ln;
		if(isws(substr($ln,0,1))) {next;} # line is comment
		if($ln eq "") {next;} # line is blank
		push @lines, $ln;
	}
	close $fd;
	return @lines;
}

sub confpairs {
	sub sep {
		my $str = shift; my @seps = @_; my $low = -1;
		foreach (@seps) {
			my $pos = index($str, $_); if ($pos != -1) {
				if (($low == -1) or ($pos < $low)) { $low = $pos; }
			}
		}
		return $low;
	}
	my @lines = @_;
	my @pairs;
	foreach (@lines) {
		my $ln = $_;
		my $i = sep $ln, ' ', "\t";
		my $j = $i;
		while ($j < length $ln) { if(isws(substr $ln, $j, 1)) { ++$j; } else {last;}}
		my $key = substr $ln, 0, $i;
		my $value = substr($ln, $j, length($ln));
		push @pairs, [$key, $value];
	}
	return @pairs;
}

my @header = readconf("sitename");
my @links = readconf("links");
my @linkpairs = confpairs(@links);

sub depth {
	my $path = shift;
	my $ct = () = $path =~ /\//g;
	return $ct;
}

sub root {
	my $depth = shift;
	-- $depth;
	if ($depth == 0) {
		return ".";
	} elsif ($depth == 1) {
		return ".."
	} else {
		my $str = "..";
		for (my $i = 0; $i!=$depth; ++$i) {
			$str .= "/..";
		}
		return $str;
	}
}

sub page {
	my ($path, $body) = @_;
	my $root = root depth $path;
	my $title;
	if ($#header >= 0) {
		$masthead = "\n\t\t<h1>$header[0]</h1>\n\t";
		$title = $header[0];
		if ($#header > 0) {
			$masthead .= "\t<h2>$header[1]</h2>\n\t";
		}
	} else {
		err "no site name specified";
	}
	my $nav = "";
	foreach (@linkpairs) {
		my $dest = $root . $_->[0];
		my $lbl = $_->[1];
		$nav .= qq[<a href="$dest">$lbl</a>\n\t\t\t];
	}
	return qq[<!doctype html>
<html>
<head>
	<meta charset="utf-8">
	<title>$title</title>
	<link rel="stylesheet" href="$root/style.css">
</head>
<body>
	<header>$masthead</header>
	<div class="inset">
		<nav>
			$nav
		</nav>
		<article>
			$body
		</article>
	</div>
</body>
</html>]
}

sub filter {
	$_[0] =~ s/&/&amp;/g;
	$_[0] =~ s/</&lt;/g;
	$_[0] =~ s/>/&gt;/g;
}
use constant {
	PLAIN => 1,
	ORDLIST => 2,
	STARLIST => 3
};
my %parsers = (
	'md' => sub { my ($inpath, $outpath) = @_;
		print "parsing markdown → \e[36m$outpath.html\e[0m";
		my $root = root depth $outpath;
		open my $in, "<:encoding(UTF-8)", $inpath;
		open my $out, ">:encoding(UTF-8)", $outpath.".html";
		my $pg = "";
		my $ctx = PLAIN;
		while (my $ln = <$in>) {
			chomp $ln;
			if ($ln ne "") {
				filter $ln;
				my $lntype;
				if ($ln =~ m{^\s*[0-9]*\.}) {
					$lntype = ORDLIST;
					$ln =~ s;^\s*[0-9]*\.\s*;;;
				} elsif ($ln =~ m{^\s*\*\s+}) {
					$lntype = STARLIST;
					$ln =~ s-^\s*\*\s+--;
				} else {
					$lntype = PLAIN;
				}

				if ($ln eq "---") { $pg .= "<hr>\n"; next; }

				# im sorry ok
				$ln =~ s;(?<!\\)\[(.+?)\]\(/(.+?)\);<a href="$root/$2">$1</a>;g;
				$ln =~ s;(?<!\\)\[(.+?)\]\((.+?)\);<a href="$2">$1</a>;g;
				$ln =~ s;(?<!\\)\*\*(.+?)(?<!\\)\*\*;<strong>$1</strong>;g;
				$ln =~ s;(?<!\\)\*(.+?)(?<!\\)\*;<em>$1</em>;g;
				$ln =~ s;(?<!\\)_(.+?)(?<!\\)_;<u>$1</u>;g;
				$ln =~ s;(?<!\\)`(.+?)(?<!\\)`;<code>$1</code>;g;
				$ln =~ s;--;—;g;
				$ln =~ s;-\\-;--;g;
				$ln =~ s;-:-;÷;g;
				$ln =~ s;-\\:-;-:-;g;
				$ln =~ s;\\(.);$1;g;
				$ln =~ s;([0-9])x([0-9]);$1×$2;g;
				$ln =~ s;([0-9])\\x([0-9]);$1x$2;g;

				if ($lntype != $ctx) { #context change
					if ($ctx == ORDLIST) {
						$pg .= "</ol>\n";
					} elsif ($ctx == STARLIST) {
						$pg .= "</ul>\n";
					}
					$ctx = $lntype;
					if ($ctx == ORDLIST) {
						$pg .= "<ol>\n";
					} elsif ($ctx == STARLIST) {
						$pg .= "<ul>\n";
					}
				}
				if ($ctx == PLAIN) {
					if ($ln =~ s;^(#+)\s*;;) {
						my $hl = length($1);
						my $id = $ln;
						$id =~ s;[^a-z0-9_\-];\-;g;
						$pg .= qq[<h$hl id="$id">$ln</h$hl>\n];
					} else {
						$pg .= "<p>$ln</p>\n";
					}
				} elsif (($ctx == ORDLIST) or
						($ctx == STARLIST)) {
					$pg .= "<li>$ln</li>\n";
				}
			}
		}
		print $out page $outpath.".html", $pg;
		close $in;
		close $out;
	},
	'txt' => sub { my ($inpath, $outpath, $basename) = @_;
		print "filtering text → \e[36m$outpath.html\e[0m";
		open my $in, "<:encoding(UTF-8)", $inpath;
		open my $out, ">:encoding(UTF-8)", $outpath.".html";
		my $pg = "<h1>$basename</h1>\n";
		while (my $ln = <$in>) {
			chomp $ln;
			if ($ln ne "") {
				filter $ln;
				$pg .= "<p>$ln</p>\n";
			}
		}
		print $out page $outpath.".html", $pg;
		close $in;
		close $out;
	},
	'html' => sub { my ($inpath, $outpath) = @_;
		print "wrapping html → \e[36m$outpath.html\e[0m";
		open my $in, "<:encoding(UTF-8)", $inpath;
		my $file;
		{ local $/; $file = <$in>; }
		close $in;
		open my $out, ">:encoding(UTF-8)", $outpath.".html";
		print $out page $outpath.".html", $file;
		close $out;
	},
	'raw' => sub { my ($inpath, $outpath) = @_;
		print "copying raw → \e[36m$outpath\e[0m";
		open my $in, "<:encoding(UTF-8)", $inpath;
		my $file;
		{ local $/; $file = <$in>; }
		close $in;
		open my $out, ">:encoding(UTF-8)", $outpath.".html";
		print $out $file;
		close $out;
	}
);

sub enter {
	my $path = shift;
	print "\e[1;34m→\e[0;34m $path\e[0m\n";
	mkdir('out'.$path);
	my @dirs;
	opendir my $dir, "src".$path or die "cannot open $! for reading";
	my @ls = readdir $dir;
	foreach (@ls) {
		# keep out dotfiles
		my $file = $_;
		if ((unpack 'a', $file) eq '.') { next; }
		
		print " \e[35m·\e[1m $file\e[0;35m ";
		if (-d 'src'.$path.$file) { # entry is a directory
			print 'deferring directory';
			push @dirs, $file;
		} else { # entry is a file
			my $ext = filext $file;
			if (exists($parsers{$ext})) {
				my $outname = 'out'.$path.basename($file);
				$parsers{$ext}('src'.$path.$file, $outname, basename($file));
			} else {
				print "no handler; copying raw → \e[36mout$path$file";
				system('cp "src'.$path.$file.'" "out'.$path.$file.'"') # haaaaack
			}
		}
		print "\e[0m\n";
	}
	closedir $dir;
	foreach (@dirs) {
		my $dir=$path.$_."/";
		enter($dir);
	}
}

if (-d "out") { system("rm -r out/*"); } # haaaaaaack
	else { mkdir "out"; }
	
enter("/");
	
print "\e[1mok\e[0m\n";