#!/usr/bin/perl -wT use strict; use CGI qw(:all); use CGI::Carp qw(fatalsToBrowser); # We want to have an HTML header before the file is parsed, so that STDERR # (which is redirected to STDOUT) is displayed in the browser. Without this, # compilation warning messages are lost. BEGIN { print "Content-Type: text/html; charset=UTF-8\n\n"; select(STDERR); $| = 1; # make unbuffered select(STDOUT); $| = 1; # make unbuffered # It's easier to get error messages on STDOUT in a CGI script open(STDERR,">&STDOUT") or die "STDERR redirect to STDOUT failed: $!"; } my $style; my $blogpost; my $perma; my $title; my $font=''; my $blogdir='/home/merlin/blog/'; # We need to set the environment since we run in '-T' mode $ENV{'PATH'}='/sbin:/bin:/usr/sbin:/usr/bin:/usr/local/bin'; $ENV{'IFS'}=' '; # You would call this script like this: # http://marc.merlins.org/cgi-bin/blogsnippet?perma=108364613511234234&title=1 # or # http://marc.merlins.org/cgi-bin/blogsnippet?perma=108364613511234234 # (the script needs help to know whether it should try to capture a title for # the blog entry, or not) $perma=param('perma'); $title=param('title'); $perma =~ /([0-9a-zA-Z-]+)/; $perma = $1 || "(nothing)"; # Yeah, this is very bad, but much shorter than the alternatives :) $style=`cat $blogdir/index.html | perl -007 -p -e 's!.*().*!\$1\n!sm' - 2>&1`; # We're hitting regex limits here, we need one for the case of a preceeding # h2 title (call with script?title=1), and the default is not to capture that # so as not to get stuck in a regex that will try to expand for way too long if ($title) { if ($perma =~ /^\d+$/) { $blogpost=`cat $blogdir/archives/*archive.html | perl -007 -p -e 's!(

[^\n]*[^\n]*)(\\s+
)(.*?)[^\n]*
.*!\$1\$2\$3\n\n!sm' - 2>&1`; } else { $blogpost=`cat $blogdir/archives/*archive.html | perl -007 -p -e 's!(

[^\n]*)(.*?)[^\n]*.*!\$1\$2\$3\n\n!sm' - 2>&1`; } # Get rid of the beginning too (avoids double .* in regex, that's bad) $blogpost =~ s/.*

/

/sm; } else { if ($perma =~ /^\d+$/) { $blogpost="The new blogger doesn't support numerical perma links for blogs without titles"; } else { # effectively, the '?' cancels the first argument since there is no title # in this case (or at least we don't look for it as the first .* will # swallow as much text as it can) # This search only works on text perma links now, not the digit ones $blogpost=`cat $blogdir/archives/*archive.html | perl -007 -p -e 's!(

[^\n]*[^\n]*)?(\\s+
)(.*?)[^\n]*
.*!\$1\$2\$3\n\n!sm' - 2>&1`; } # Get rid of the beginning too (avoids double .* in regex, that's bad) $blogpost =~ s/.*(\s+
/i); $blogpost="Nothing found for $perma" if ($blogpost =~ /<\/body>/i); $blogpost =~ s#="media#="/blogmedia#g; $blogpost =~ s#=media#=/blogmedia#g; $blogpost =~ s#
#
\n#g; print start_html( {-title=>"Blog entry", -head=>$style.$font, -encoding=>"UTF-8"} ), h1("Blog entry"), br, '
'; print $blogpost; print "
", end_html; exit;