gen

#!/usr/bin/env perl
use 5.20.0;
use Cwd;

my $URL = 'http://prog21.dadgum.com';
my $CWD = cwd;

sub load {local (@ARGV, $/) = @_; <>}

sub save {
	my $f = "site/" . shift;
	my $s = join '', @_;
	unless (-e $f and -s $f == length($s) and $s eq load($f)) {
		open my $h, '>', $f; print $h $s; close $h;
		chmod 0644, $f;
	}
}

my ($HEAD,$BODY,$FOOT) = split /~/, load('p21.html') =~ s/\n\t*//gr;

my (@Titles, @Dates);
my $Latest = do {
	my $f = load 'titles';
	@Dates = (0, $f =~ /^(....-..-..)/gm);
	@Titles = (0, $f =~ / (.+)$/gm);
} - 1;

my @Months = qw(January February March April May June July August September October November December);

sub long_date {
	my ($y, $m, $d) = shift =~ /(\d+)-(\d+)-0*(\d+)/;
	$Months[$m - 1] . " $d, $y";
}

sub parse {
 	my $s = load "entries/$_[0].html";
	my ($style, $script, @t);
	for (;;) {
		$s =~ m[\G\s*]smgc;
		push(@t, ['code', $1]), next if $s =~ m[\G^---\n(.+?)\n---$]smgc;
		push(@t, ['quote',$1]), next if $s =~ m[\G^"""\n(.+?)\n"""$]smgc;
		$script .= $1,          next if $s =~ m[\G^<script>\n(.+?\n)</script>$]smgc;  
		$style .= $1,           next if $s =~ m[\G^<style>\n(.+?\n)</style>$]smgc;     
 		push(@t, ['prose',$1]), next if $s =~ m[\G^(.+?)(?=\n---|\n"""|\n<script>|\n<style>|\Z)]smgc;
		last;
	}
	($style, $script, @t); 
}

sub prose {
	map {
		s:<\|:<code>:g;
		s:\|>:</code>:g;
		/^<[phu]/ ? $_ : "<p>$_</p>"
	} split /\n\n/, $_[0];
}

sub code {
	map {
		s/\t/   /g;
		s/&/&amp;/g;
		s/</&lt;/g;
		s/>/&gt;/g;
		$_
	} @_;
}

sub gen_body {
	my %f = (
		prose => sub {prose($_[0])},
		code => sub {('<pre>', code($_[0]), '</pre>')},
		quote => sub {('<blockquote>', prose($_[0]), '</blockquote>')}
	);
 	map {$f{$_->[0]}->($_->[1])} @_;
}

sub gen_prev {
	my ($n) = @_;
	my @p = reverse map {"<li><a href=$_.html>$Titles[$_]</a>"} grep {$_ > 0} $n-5..$n-1;
	@p ? ('<h1>previously</h1><ul>', @p, '</ul>') : ();
}

sub gen_page {
	my ($n) = @_;
	my $d = long_date $Dates[$n];
	my $t = $Titles[$n];
	my ($style, $script, @doc) = parse $n;
	my @core = ($style, $BODY, "<h1>$t</h1>", gen_body(@doc), 
		qq{<p class="s"><a href="$n.html" id="perm">permalink</a> <i>$d</i></p>},
		gen_prev($n), $FOOT);
	push @core, "<script>\n", $script, "</script>" if $script;
 	save "$n.html", $HEAD =~ s/X/$t/r, @core;
	save "index.html", $HEAD =~ s/X/Programming in the 21st Century/r, @core if $n == $Latest
}

my $ATOM = <<END;
<?xml version="1.0" encoding="utf-8" standalone="yes"?>
<feed xmlns="http://www.w3.org/2005/Atom">
<title>Programming in the 21st Century</title>
<link rel="self" href="$URL/atom.xml"/>
<link rel="alternate" href="$URL/"/>
<id>$URL/</id>
END

sub abs_url {
	my $u = shift;
	$u =~ /:/ ? $u : "$URL/$u";
}

sub gen_feed {
	my $n = $Latest;
	my $t = 'T00:00:00-06:00';
	my @out = map {
		my ($style, $script, @doc) = parse $_;
		my $body = join('', gen_body @doc) =~ s/((href|src)=")(.+?)"/$1 . abs_url($3) . '"'/ger;
		my $time = "$Dates[$_]$t";
		<<END;
<entry>
<title>$Titles[$_]</title>
<link rel="alternate" type="text/html" href="$URL/$_.html"/>
<id>$URL/$_.html</id>
<published>$time</published>
<updated>$time</updated>
<author><name>James Hague</name></author>
<content type="xhtml"><div xmlns="http://www.w3.org/1999/xhtml">$body</div></content>
</entry>
END
	} reverse grep {$_ > 0} $n-2..$n;
	save 'atom.xml', $ATOM, "<updated>$Dates[$n]$t</updated>\n", @out, '</feed>';
}

sub gen_archive {
	my ($last, @out);
	for my $i (reverse 1..$Latest) {
		my $year = substr $Dates[$i], 0, 4;
		push @out, "<h1>$year</h1>" if $year ne $last;
		push @out, qq|<a href=$i.html>$Titles[$i]</a>|;
		$last = $year;
	}
	save "archives.html", $HEAD =~ s/X/Complete Archives/r, $BODY, '<div class="ab">',@out,"</div>", $FOOT;
}


symlink "$CWD/images", "site/images";

my @pages;
if (@ARGV == 0) {
	@pages = $Latest;
} elsif (@ARGV == 1 && $ARGV[0] eq 'all') {
	@pages = 1..$Latest;
} else {
	@pages = map {
		(/^(\d+)$/ and $Titles[$1]) or die "gen [1-$Latest...|all]\n";
		$1;
	} @ARGV;
}

gen_page $_ for @pages;
gen_feed;
gen_archive;