BlogAlba/blogalba

#!/usr/bin/env perl
# BlogAlba - no-frills markdown blogging system

package App::BlogAlba;

use strict;
use warnings;

use Cwd;
use HTML::Template;
use Text::Markdown::Hoedown;
use YAML;

use POSIX qw/strftime/;
use Date::Parse qw/str2time/; #Required for converting the date field in posts to something strftime can work with
use Time::HiRes qw/gettimeofday tv_interval/;
use XML::RSS;
use Unicode::Normalize;

use Dancer2;

my $HOST = `hostname -s`; chomp $HOST;

my $basedir=$ENV{BLOGALBA_DIR} || cwd();
my $cfg="$basedir/config";
my $blog=YAML::LoadFile($cfg) or die "Couldn't load $cfg!";
$blog->{url} .= '/' unless $blog->{url} =~ /\/$/;

my ($page,@posts,@pages,%defparams);
my $nposts=0;my $npages=1;my $lastcache=0;

sub readpost {
	my $file = shift;my $psh = shift || 1;
	my $postb = ""; my $postmm = "";
	open POST, $file or warn "Couldn't open $file!" and return 0;
	my $status = 0;
	while (<POST>) {
		$postb .= $_ if $status==2;
		/^-{3,}$/ and not $status==2 and $status = $status==1? 2 : 1;
		$postmm .= $_ if $status==1;
	}
	close POST; undef $status;
	my %postm = %{YAML::Load($postmm)}; undef $postmm;
	$postm{filename} = $1 if $file =~ /(?:^|\/)([a-zA-Z0-9\-]*)\.md$/;
	$postm{body} = markdown(
		$postb,
		extensions => HOEDOWN_EXT_TABLES
			| HOEDOWN_EXT_FENCED_CODE
			| HOEDOWN_EXT_FOOTNOTES
			| HOEDOWN_EXT_AUTOLINK
			| HOEDOWN_EXT_STRIKETHROUGH
			| HOEDOWN_EXT_UNDERLINE
			| HOEDOWN_EXT_HIGHLIGHT
			| HOEDOWN_EXT_SUPERSCRIPT
			| HOEDOWN_EXT_NO_INTRA_EMPHASIS);
	$postm{mdsource} = $postb;
	undef $postb;
	if (defined $postm{date}) {
		$postm{slug} = slugify($postm{title}) unless $postm{slug}; #we allow custom slugs to be defined
		$postm{hastags} = 1 unless not defined $postm{tags};
		$postm{excerpt} = $1 if $postm{body} =~ /(<p>.*?<\/p>)/s;
		$postm{time} = str2time($postm{date});
		$postm{fancy} = timefmt($postm{time},'fancydate');
		$postm{datetime} = timefmt($postm{date},'datetime');
		$postm{permaurl} = $blog->{url}.$blog->{posturlprepend}.timefmt($postm{time},'permalink').$postm{slug};
	}
	push @posts,{%postm} if $psh==1; push @pages,{%postm} if $psh==2;return %postm;
}
sub slugify {
	my $t = shift;
	$t = lc NFKD($t); #Unicode::Normalize
	$t =~ tr/\000-\177//cd; #Strip non-ascii
	$t =~ s/[^\w\s-]//g; #Strip non-words
	chomp $t;
	$t =~ s/[-\s]+/-/g; #Prevent multiple hyphens or any spaces
	return $t;
}
sub timefmt {
	my ($epoch,$context)=@_;
	$epoch=str2time $epoch if $epoch !~ /^[0-9]{10}$/;
	my $dsuffix = 'th'; $dsuffix = 'st' if strftime("%d",localtime $epoch) =~ /1$/; $dsuffix = 'nd' if strftime("%d",localtime $epoch) =~ /2$/;
	return strftime "%A, %e$dsuffix %b. %Y", localtime $epoch if $context eq 'fancydate';
	return strftime "%Y-%m-%dT%H:%M%z",localtime $epoch if $context eq 'datetime';
	return strftime "%Y-%m",localtime $epoch if $context eq 'writepost';
	return strftime "%Y/%m/",localtime $epoch if $context eq 'permalink';
	return strftime $context, localtime $epoch if $context;
	return strftime $blog->{config}->{date_format},localtime $epoch;
}
sub pagination_calc {
	my $rem=$nposts % $blog->{config}->{per_page};
	$npages=($nposts-$rem)/$blog->{config}->{per_page};
	$npages++ if $rem>0 or $npages<1;
}
sub get_index {
	my @iposts = @_;
	$page->param(pagetitle => $blog->{name}, INDEX => 1, POSTS => [@iposts]);
	return $page->output;
}
sub paginate {
	my $pagenum = shift; my $offset = ($pagenum-1)*$blog->{config}->{per_page};
	my $offset_to = $offset+($blog->{config}->{per_page}-1); $offset_to = $#posts if $offset_to > $#posts;
	$page->param(PAGINATED => 1, prevlink => ($pagenum>1? 1 : 0), prevpage => $pagenum-1, nextlink => ($pagenum<$npages? 1 : 0), nextpage => $pagenum+1);
	return get_index @posts[$offset..(($offset+$blog->{config}->{per_page})>$#posts? $#posts : ($offset+($blog->{config}->{per_page}-1)))];
}
sub page_init {
	$page = HTML::Template->new(filename => "$basedir/layout/base.html",die_on_bad_params => 0,utf8 => 1,global_vars => 1);
	$page->param(%defparams);
}
sub get_post {
	my ($y,$m,$slug) = @_;
	for my $r (@posts) {
		my %post = %$r;
		next unless $post{slug} eq $slug and timefmt($post{time},'writepost') eq "$y-$m";
		$page->param(pagetitle => "$post{title} - $blog->{name}",%post);
		return 1;
	}
	return undef;
}
sub get_page {
	my $pname = shift;
	for my $r (@pages) {
		my %cpage = %$r;
		next unless $cpage{filename} eq $pname;
		$page->param(pagetitle => "$cpage{title} - $blog->{name}",%cpage);
		return 1;
	}
	return undef;
}
sub generate_feed {
	my $feed = new XML::RSS(version => '2.0');
	$feed->channel (
		title			=> $blog->{name},
		link			=> $blog->{url},
		description		=> $blog->{tagline},
		dc	=> {
			creator		=> $blog->{author},
			language	=> "en-gb",
		},
		syn	=> {
			updatePeriod	=> "daily",
			updateFrequency	=> "1",
			updateBase		=> "1970-01-01T00:00+00:00",
		},
	);
	$feed->add_item (
		title			=> $_->{title},
		link			=> $_->{permaurl},
		description		=> ($blog->{config}->{rss_excerpt}? $_->{excerpt} : $_->{body}),
		dc	=> { creator => $blog->{author}, },
	) for @posts[0 .. ($#posts > ($blog->{config}->{rss_posts}-1)? ($blog->{config}->{rss_posts}-1) : $#posts)];
	$feed->save("$basedir/public/feed-rss2.xml");
}
sub do_cache {
	return if $lastcache > (time - 3600);
	$lastcache = time;my $st=[gettimeofday];
	undef @posts;undef @pages;
	opendir POSTS, "$basedir/posts/" or die "Couldn't open posts directory $basedir/posts/";
	while(readdir POSTS) {
		next unless /\.md$/;
		warn "Error reading post $_\n" and next unless readpost("$basedir/posts/$_",1);
		$nposts++;
	}
	closedir POSTS;
	@posts = map {$_->[1]} sort {$b->[0] <=> $a->[0]} map {[$_->{time},$_]} @posts;

	opendir PAGES, "$basedir/pages/" or die "Couldn't open pages directory $basedir/pages/";
	while(readdir PAGES) {
		next unless /\.md$/;
		warn "Error reading page $_\n" and next unless readpost("$basedir/pages/$_",2);
	}
	closedir PAGES;

	my @nav;
	push @nav, {navname => $_->{title}, navurl => "$blog->{url}$_->{filename}",} for @pages;
	push @nav, {navname => $_, navurl => $blog->{links}->{$_},} for sort { $b cmp $a } keys $blog->{links};
	generate_feed;
	%defparams = (
		INDEX => 0, NAV => [@nav], url => $blog->{url}, recent => [@posts[0 .. ($#posts > ($blog->{config}->{rss_posts}-1)? ($blog->{config}->{rss_posts}-1) : $#posts)]],
		gentime => timefmt($lastcache, '%H:%M %e/%-m/%y %Z'), genworktime => sprintf("%.2f ms", tv_interval($st)*100), host => $HOST,
		about => $blog->{about}, author => $blog->{author}, name => $blog->{name}, tagline => $blog->{tagline}, keywords => $blog->{keywords},
		robots => $blog->{config}->{indexable}? '<meta name="ROBOTS" content="INDEX, FOLLOW" />' : '<meta name="ROBOTS" content="NOINDEX, NOFOLLOW" />',
	);
	pagination_calc;
}

set server => '127.0.0.1';
set port => 42069;

hook 'before' => sub {
	do_cache;
	page_init;
};

get '/' => sub {
	return get_index @posts if $npages==1;
	return paginate 1;
};
get '/page/:id' => sub {
	pass unless params->{id} =~ /^[0-9]+$/ and params->{id} <= $npages;
	return redirect '/' unless $npages > 1 and params->{id} > 1;
	return paginate params->{id};
};
get '/wrote/:yyyy/:mm/:slug' => sub {
	pass unless params->{yyyy} =~ /^[0-9]{4}$/ and params->{mm} =~ /^(?:0[1-9]|1[0-2])$/ and params->{slug} =~ /^[a-z0-9\-]+(?:\.md)?$/i;
	$page->param(SOURCEVIEW => 1) if params->{slug} =~ s/\.md$//;
	$page->param(ISPOST => 1);
	get_post params->{yyyy}, params->{mm}, params->{slug} or pass;
	return $page->output;
};
get '/:extpage' => sub {
	pass unless params->{extpage} =~ /^[a-z0-9\-]+(?:\.md)?$/i;
	$page->param(SOURCEVIEW => 1) if params->{extpage} =~ s/\.md$//;
	$page->param(ISPOST => 0);
	get_page params->{extpage} or pass;
	return $page->output;
};
# 404
any qr{.*} => sub {
	return redirect '/' if request->path =~ /index(?:\.(?:html?|pl)?)?$/;
	status 'not_found';
	return redirect '/404.html';
};

start;