#!/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/&/&/g;
$_[0] =~ s/</</g;
$_[0] =~ s/>/>/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";