#!/usr/bin/perl -w

# Blosxom
# Author: Rael Dornfest <rael@oreilly.com>
# Version: 3+5i
# Home/Docs/Licensing: http://www.oreillynet.com/~rael/lang/perl/blosxom/

# --- Configurable variables -----

# What's this blog's title?
my $blog_title = 'Sam Ruby';

# What's this blog's description (for outgoing RSS feed)?
my $blog_description = "It's just data";

# What's this blog's primary language (for outgoing RSS feed)?
my $blog_language = 'en-us';

# Where are this blog's entries kept?
my $datadir = "/home/rubys/web/intertwingly.net/blosxom/";
my $datadir_current = $datadir;

# Should I stick only to the datadir for items or travel down the
# directory hierarchy looking for items?  If so, to what depth?
# 0 = infinite depth (aka grab everything), 1 = datadir only, n = n levels down
my $depth = 0;

# What should be used as separator in directory paths (the $path variable)?
my $path_separator = '/';

# How many entries should I show on the home page?
my $num_entries = 20;

# --------------------------------

use strict;
use FileHandle;
use File::Find;
use File::stat;
use Lucene;
use Time::localtime;
use CGI qw/:standard :netscape/;
use POSIX qw/strftime/;
use Text::Wrap;

$Text::Wrap::columns = 78;

# Escape <, >, and &, and to produce valid RSS
my %escape = ('<'=>'&lt;', '>'=>'&gt;', '&'=>'&amp;', '"'=>'&quot;');  
my $escape_re  = join '|' => keys %escape;

my %unescape = map {$escape{$_} => $_} keys %escape;
$unescape{'&nbsp;'} = ' ';
$unescape{'&rsquo;'} = "'";
$unescape{'&laquo;'} = chr(171);
$unescape{'&raquo;'} = chr(187);
$unescape{'&lsaquo;'} = chr(171);
$unescape{'&rsaquo;'} = chr(187);
my $unescape_re  = join '|' => keys %unescape;

# Fix depth to take into account datadir's path
$depth and $depth += ($datadir =~ tr[/][]) - 1;

# Take a gander at HTTP's PATH_INFO for optional blog name, archive yr/mo/day
my $url = url();
$url =~ s/^included:/http:/; # Fix for Server Side Includes (SSI)
my @pi = split m{/}, path_info(); 
shift @pi;
@pi=() if (path_info() =~ m[^//]); # Fix for no trailing slash
my $pi_bl = '';
while ($pi[0] =~ /^[a-zA-Z]\w*$/) { $pi_bl .= '/' . shift @pi; }

$ENV{'REQUEST_METHOD'} =~ tr/a-z/A-Z/;

#parse entry, source, filename to determine flavour, ext
my $entry = param('entry');
my $ext = (param('source') eq 'comments') ? 'cmt' : 'txt';
my $flavour = param('flav') || ($ext eq 'cmt' ? 'rss' : 'html');
$pi[$#pi] =~ /(.*)\.(\w*)/ and ($entry, $flavour) = ($1, $2), pop(@pi);
$entry = undef if $entry eq 'index';
$entry = undef, $ext = 'cmt' if $entry eq 'comment';
$flavour = 'comment' if $flavour eq 'html' and $entry;
$flavour = 'text' if $flavour eq 'txt';
$flavour = 'preview' if param('preview');
$flavour = 'tbrss' if param('__mode') eq "rss";
$flavour = 'tbform' if ($flavour eq 'tb') and ($ENV{'REQUEST_METHOD'} eq "GET") and not param('title');

# Check the existence and readability of a specified sub-blog
$pi_bl and -d "$datadir_current/$pi_bl" and -r "$datadir_current/$pi_bl" and $datadir_current .= "/$pi_bl", $url .= "/$pi_bl", $blog_title .= ": $pi_bl";

# Date fiddling
my($pi_yr,$pi_mo,$pi_da) = @pi;
my %month2num = (nil=>'00', Jan=>'01', Feb=>'02', Mar=>'03', Apr=>'04', May=>'05', Jun=>'06', Jul=>'07', Aug=>'08', Sep=>'09', Oct=>'10', Nov=>'11', Dec=>'12');
my @num2month = sort { $month2num{$a} <=> $month2num{$b} } keys %month2num;
my $pi_mo_num = $pi_mo ? ( $pi_mo =~ /\d{2}/ ? $pi_mo : ($month2num{ucfirst(lc $pi_mo)} || undef) ) : undef;

my $fh = new FileHandle;
my $tb_resp = "<error>1</error><message>excerpt not found</message>";

# Bring in the templates
my %template = ();
while (<DATA>) {
	last if /^(__END__)?$/;
	my($ct, $comp, $txt) = /^(\S+)\s(\S+)\s(.*)$/;
	$txt =~ s/\\n/\n/mg;
	$template{$ct}{$comp} = $txt;
}

$template{'html'}{'content_type'}='application/xhtml+xml;charset=iso-8859-1'
  if $ENV{'HTTP_ACCEPT'} =~ /application\/xhtml\+xml/;

chomp(my $content_type = $fh->open("< $datadir_current/content_type.$flavour") || $fh->open("< $datadir/content_type.$flavour") ? join("",<$fh>) : ($template{$flavour}{'content_type'} || 'text/plain'));
print "Content-Type: $content_type\r\n\r\n";
$content_type =~ s/[[\r\n].*//;

# Write any comments
my $body;
my $name = param('name') || param('blog_name') || 'anonymous';
my $addr = param('url');
my $email = param('email');
my $title = param('title');
# my $bakeCookie = 'CHECKED' if param('bakecookie');
my $comment = param('comment') || param('excerpt');
my $tb_id = param('parent') || param('tb_id') || $entry;
if ($title and $comment and $tb_id) {
	$addr =~ s[^(\w+(\.\w+)+)][http://$1]g;
        $addr ||= 'mailto:'.$email if $email;

	$title =~ s/($escape_re)/$escape{$1}/g;

	my $punc = '[\s.:;?\-\[\]]';

	$body = $comment;
	$body =~ s/\s+$//g;
	$body =~ s/<br\s*\/?>/\n/g;
        $body =~ s[(^|$punc)(http://[-\w;/?:@&=+\$\.!~*'()%,#]+[\w/])($|$punc)][$1<a href="$2">$2</a>$3]g;
	$body =~ s/($escape_re)/$escape{$1}/g;
	$body =~ s/\r//g;
	$body =~ s/\n/<br \/>/g;
        $body =~ s/\&lt;a href=\&quot;([^\&]*)\&quot;\&gt;([^\&]*)&lt;\/a\&gt;/<a href="$1">$2<\/a>/g;
        $body =~ s/\&lt;a href='([^\&]*)'\&gt;([^\&]*)&lt;\/a\&gt;/<a href="$1">$2<\/a>/g;
        $body =~ s/\&lt;em\&gt;([^\&]*)&lt;\/em\&gt;/<em>$1<\/em>/g;
        $body =~ s/\&lt;i\&gt;([^\&]*)&lt;\/i\&gt;/<i>$1<\/i>/g;
        $body =~ s/\&lt;b\&gt;([^\&]*)&lt;\/b\&gt;/<b>$1<\/b>/g;
        $body =~ s/\&lt;blockquote\&gt;([^\&]*)&lt;\/blockquote\&gt;/<blockquote>$1<\/blockquote>/g;

        if (param('comment')) {
        	$body .= "\n<br /><br />Posted by";
        } else {
        	$body .= "...\n";
		$body .= "<a href=\"$addr\">[more]</a>" if $addr;	
		$addr = undef;
		$addr = "http://$name/" if $name =~ /^\w+\.[\w\.]+$/;
		$addr = $name if $name =~ /^http:\/\//;
		$body .= "<br /><br />Trackback from";
        }

	my $id = $name;
	my $host = $ENV{'REMOTE_ADDR'};
	$host = $1 if `host $host` =~ / domain name pointer (\S+)\.$/;
	$id = "<a href=\"$addr\" title=\"$host\">$name</a>" if $addr;
	$body .= " $id";

        if ($flavour ne 'preview') {
		$fh->open(">$datadir_current".$tb_id.'-'.time.'.cmt');
        	print $fh "$title\n$body\n";
        	$fh->close;
	}

	$tb_resp = "<error>0</error>";
}

# read parent entry of comment thread
my $alternate = "$url/index.rss2";
if ($entry) {
	$fh->open("< $datadir_current/$entry.txt");
	chomp($title = <$fh>);
	chomp($body = join '', <$fh>);
	$title =~ s/<.*?>//msg;

	(my $plainbody = $body) =~ s/<.*?>//msg;
	$plainbody = $1 if $body =~ s/<div\s+class="excerpt">(.*?)<\/div>\s*//s;
	$plainbody = fill("\t", "\t", split('\n', $plainbody));
	$plainbody =~ s/\n\n/\n\t\n/msg;
	$plainbody =~ s/($unescape_re)/$unescape{$1}/g;
        if ($content_type =~ m{\Wxml$}) {
        	$body =~ s/&nbsp;/ /g;
		$body =~ s/($escape_re)/$escape{$1}/g;
        }

	$blog_title .= ": $title";
	$alternate = "$url/$entry.rss2";
}

# Header
my $head = join '', ($fh->open("< $datadir_current/head.$flavour") || $fh->open("< $datadir/head.$flavour") ? <$fh> : ($template{$flavour}{'head'} || $template{'error'}{'head'}));
$head =~ s/^<%(.*?)%>\s*/$1 . ";''"/see;
$head =~ s/(\$\w+(::\w+)?)/$1 . "||''"/gee;
print $head;

# determine what files to include
my $direction = -1;
my @files;
if (param('q')) {
	@files = map {"$datadir_current$_"} (new Lucene(param('q')))->read;
        @files = grep {-e $_} @files;
	$num_entries = 100;
} elsif ($pi_bl =~ m[^/archives/cite/(.*)]) {
	my $author = $1;
	$author =~ s/[_]/ /g;

	foreach my $blog (glob("$datadir_current/*.txt")) {
  		open FILE, $blog;
  		my $title = <FILE>;
  		my $entry = join(' ', <FILE>);
  		close FILE;
		
  		$entry =~ s/<!--StartFragment -->//g;
  		$entry =~ s/&nbsp;/ /msg;
  		$entry =~ s/\s+/ /msg;
		$entry =~ s/^<p> ?(.*?) ?<\/p>/\1/;
		
		(my $cite) = ($entry =~ /^<a href="[^"]*?"> ?([^<]*?)<\/a>:? ?<em>/);
  		next unless $cite;
  		$cite =~ s/<.*?>//g;
  		$cite =~ s/:? *$//;
  		$cite =~ s/^ //;

		$cite = lc($cite);
		$cite =~ s/^jon$/jon udell/;
		$cite =~ s/^dave$/dave winer/;
		$cite =~ s/^diveintomark$/mark pilgrim/;
		$cite =~ s/^burningbird$/shelley powers/;
		$cite =~ s/^sanjiva$/sanjiva weerawarana/;
		$cite =~ s/.*decafbad/les orchard/;
		$cite =~ s/l.m.orchard/les orchard/;
		$cite =~ s/ernie.*/ernie svenson/;
		$cite =~ s/\.net guy/brad wilson/;
		$cite =~ s/dotnetguy/brad wilson/;
		$cite =~ s/[^\w\s]//g;

  		push @files, $blog if $cite eq $author;
	}
	
} elsif ($entry) {
	@files = glob("$datadir_current/$entry-*.cmt");
	$direction = +1;

	my $id = $entry;
        my $mdate = stat("$datadir_current/$entry.txt")->mtime;
        my $date = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($mdate));
        my $curdate = strftime("%a, %d %b %Y", gmtime($mdate));
	my $link = "$url/$entry.html";
	my $parent = join '', ($fh->open("< $datadir_current/parent.$flavour") || $fh->open("< $datadir_current/parent.$flavour") || $fh->open("< $datadir_current/story.$flavour") || $fh->open("< $datadir/story.$flavour") ? <$fh> : ($template{$flavour}{'story'} || $template{'error'}{'story'}));
	$parent =~ s/(\$\w+)/$1 . "||''"/gee;
	print $parent;
	$num_entries = 1000;
} else {
	find({ wanted => sub { my $curr_depth = $File::Find::dir =~ tr[/][]; return if $depth and $curr_depth > $depth; /.$ext$/ and push @files, $File::Find::name; }, follow_fast => 1 }, $datadir_current);
}

# Send in the blogs
my $curdate = '';

@files = () if $flavour eq 'preview';
@files = () if $flavour eq 'tbform';

my %files = map { $_ => stat($_)->mtime*$direction} @files;
foreach ( sort { $files{$a} <=> $files{$b} } keys %files ) {
	last if $num_entries-- <= 0 && !$pi_yr;
	my($fn,$ext) = ($_ =~ /^$datadir_current\/?(.*)\.(\w*)$/);

	# Date fiddling for by-{year,month,day} archive views
	my $mtime = ctime(stat("$datadir_current/$fn.$ext")->mtime);
	my($dw,$mo,$da,$ti,$yr) = ( $mtime =~ /(\w{3}) +(\w{3}) +(\d{1,2}) +(\d{2}:\d{2}):\d{2} +(\d{4})$/ );
	$da = sprintf("%02d", $da);
	my $mo_num = $month2num{$mo};

	next if $pi_yr && $yr != $pi_yr; last if $pi_yr && $yr < $pi_yr; 
	next if $pi_mo && $mo_num != $pi_mo_num;
	next if $pi_da && $da != $pi_da; last if $pi_da && $da < $pi_da; 

	$content_type eq 'text/html' && $curdate ne "$dw, $da $mo $yr" && 
		print '<h2>' . ($curdate = "$dw, $da $mo $yr") . '</h2>'; 

	my($path) = ($fn =~ /^(.*)\//);
	$path_separator and $path and $path =~ s#/#$path_separator#g;

	# Entry
	if (-T "$datadir_current/$fn.$ext" && $fh->open("< $datadir_current/$fn.$ext")) {
        	my $mdate = abs($files{$_});
        	my $date = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime($mdate));
		chomp(my $title = <$fh>);
		chomp(my $body = join '', <$fh>);

	        (my $plainbody = $body) =~ s/<.*?>//msg;
		$plainbody = $1 if $body =~ s/<div\s+class="excerpt">(.*?)<\/div>\s*//s;
	        $plainbody = fill("\t", "\t", split('\n', $plainbody));
	        $plainbody =~ s/\n\n/\n\t\n/msg;
	        $plainbody =~ s/($unescape_re)/$unescape{$1}/g;

		my ($more) = ($body =~ m{^<a href="(.*?)">\[more\]</a><br /><br />Trackback from}m);
		$more ||= '';
		next if ($flavour eq "tbrss") and (not $more);
		(my $back = $more) =~ s/#/%23/g;
		$body =~ s/>\[more\]<\/a>/>\[more\]<\/a><a href="http:\/\/www.intertwingly.net\/backtrack.cgi?url=$back">[back]<\/a>/ if $more;


        	if ($content_type =~ m{\Wxml$}) {
			$title =~ s/($escape_re)/$escape{$1}/g;
			$body =~ s/($escape_re)/$escape{$1}/g;
			$plainbody =~ s/($escape_re)/$escape{$1}/g;
		}

		$fh->close;

                my $id = $fn;
                $fn = $1 if $ext eq 'cmt' and $id =~ s/(.*)-(\d*)$/$2/;
		my $link = ($ext eq 'cmt') ? "$url/$fn.html#c$id" : "$url/$fn.html";

                my @cmt = glob("$datadir_current/$fn-{*}.cmt"); 
                my ($cmtx,$cmts) = ($#cmt+1, sprintf("(%.1d)", $#cmt+1));
		my $story = join '', ($fh->open("< $datadir_current/story.$flavour") || $fh->open("< $datadir/story.$flavour") ? <$fh> : ($template{$flavour}{'story'} || $template{'error'}{'story'}));
		$story =~ s/(\$\w+)/$1 . "||''"/gee;
		print $story;
		$fh->close;
	}
}

# Foot
my $foot = join '', ($fh->open("< $datadir_current/foot.$flavour") || $fh->open("< $datadir/foot.$flavour") ? <$fh> : ($template{$flavour}{'foot'} || $template{'error'}{'foot'}));
$foot =~ s/(\$\w+)/$1 . "||''"/gee;
while ( $foot =~ s/^(#include "(.*?)")$/$fh->open("$datadir_current\/$2") ? join "",<$fh> : "$1"/gme ) {}
print $foot;

# Default HTML and RSS template bits
__DATA__
html content_type text/html
html head <html><head><link rel="alternate" type="type="application/rss+xml" title="RSS" href="$url/?flav=rss" /><title>$blog_title $pi_da $pi_mo $pi_yr</title></head><body><center><font size="+3">$blog_title</font><br />$pi_da $pi_mo $pi_yr</center><p />
html story <p class="blosxomEntry"><a name="$fn"><span class="blosxomTitle"><b>$title</b></span></a><br /><span class="blosxomBody">$body</span><br /><span class="blosxomTime">Posted at $ti</span> [$path] <a href="$link">#</a> <a href="http://www.google.com/search?q=$title">G</a></p>\n
html foot <p /><center><h6>Powered -- for some narrow definition of powered -- by <a href="http://www.oreillynet.com/~rael/lang/perl/blosxom/">Blosxom</a></h6></body></html>
rss content_type text/xml
rss head <?xml version="1.0" encoding="iso-8859-1"?>\n<!-- name="generator" content="blosxom/3+5i" -->\n<!DOCTYPE rss PUBLIC "-//Netscape Communications//DTD RSS 0.91//EN" "http://my.netscape.com/publish/formats/rss-0.91.dtd">\n\n<rss version="0.91">\n  <channel>\n    <title>$blog_title $pi_da $pi_mo $pi_yr</title>\n    <link>$url/</link>\n    <description>$blog_description</description>\n    <language>$blog_language</language>\n
rss story   <item>\n    <title>$title</title>\n    <link>$link</link>\n    <description>$body</description>\n  </item>\n
rss foot   </channel>\n</rss>
error head Error: I'm afraid this is the first I've heard of a "$flavour" flavoured Blosxom.  Try dropping the "/+$flavour" bit from the end of the URL.\n\n
html content_type text/html