#!/usr/bin/perl
=pod
=head1 NAME
Display - module to display fragments of text on the web and elsewhere
=head1 DESCRIPTION
Display started life as a simple script to concatenate fragments of
handwritten HTML by date. While it's since haphazardly accumulated
several of the usual weblog features (comments, lightweight markup, feed
generation, embedded Perl, poetry tools, stupid dependencies), the present
module hasn't changed much in six years.
This version should work with FastCGI, via CGI::Fast, if called from the
appropriate wrapper script.
Entries are stored in a simple directory tree under
C<$DISPLAY_CONF{ROOT_DIR}>.
Like:
archives/2001/1/1
archives/2001/1/1/sub_entry
An entry may be either a plain text file, or a directory containing several
such files + whatever else you'd like to store. If it's a directory, the file
called "index" will be treated as the text of the entry, and all other lower
case filenames without extensions will be treated as sub-entries or documents
within that entry, and displayed accordingly.
Directories may be nested to an arbitrary depth, though I don't promise that
this won't break on you.
A PNG or JPEG file with a name like
2001/1/1.icon.png
2001/1/1/index.icon.png
2001/1/1/whatever.icon.png
will be treated as an icon for the appropriate entry file.
=head2 MARKUP
Entries may consist of hand-written HTML (to be passed along without further
interpretation), a supported form of lightweight markup, or some combination
thereof. Actually, an entry may consist of any darn thing you please, as long
as Perl will agree that it is text, but presumably you're going to be feeding
this to a browser.
Special markup is indicated by a variety of XML-style container tags.
B - evaluated and replaced by whatever value you return
(evaluated in a scalar context):
my $dog = "Ralph."; return $dog;
This code is evaluated before any other processing is done, so you can return
any other markup understood by the script and have it handled appropriately.
B - actually keys to %TEMPLATE, for the moment:
$TEMPLATE{dog} = "Ralph"; return '';
My dog is named ${dog}.
Embedded code and variables are mostly intended for use in F and
F
\n\n
",
list => "\n\n
" );
my %newlines = ( freeverse => " \n" );
my %dashes = ( freeverse => ' — ' );
sub line_parse {
my ($everything, $file) = (@_);
# eval embedded Perl and ${variables}:
eval_perl($everything);
# take care of wala markup
$everything =~ s/(.*?)<\/wala>/Wala::wikify($1)/seg;
# take care of textile markup, if we've got any
textile_process($everything);
# evaluate tags.
$everything =~ s!(.*?)!image_markup($file, $1)!seg;
foreach my $key (keys %tags) {
# Set some replacements, unless they've been explicitly set already.
$end_tags{$key} = $tags{$key} unless $end_tags{$key};
$blank_lines{$key} = "\n\n" unless $blank_lines{$key};
$newlines{$key} = "\n" unless $newlines{$key};
$dashes{$key} = " -- " unless $dashes{$key};
while ($everything =~ m/(<$key>.*?<\/$key>)/s) {
my $block = $1;
# save the bits between instances of the block --
my (@interstice_array) = split (/\Q$block\E/s, $everything);
# now, transform the contents of the block we've found:
# tags that surround the block
$block =~ s/\n?<$key>\n?/<$tags{$key}>/gs;
$block =~ s!\n?$key>\n?!$end_tags{$key}>!gs;
# dashes
$block =~ s/(\s+)\-{2}(\n|\s+|$)/$1$dashes{$key}$2/gs;
# blank lines within the block
$block =~ s/\n\n/$blank_lines{$key}/gs;
# single newlines (i.e., line ends) within the block
# except those preceded by a double-quote, which probably
# indicates a still-open tag:
$block =~ s/([^"\n])\n([^\n])/$1$newlines{$key}$2/gs;
# and slap it all back together as $everything
$everything = join $block, @interstice_array;
}
}
return $everything;
}
}
=item textile_process
Inline replace markup in a string.
Trying to implement some caching here, though it's questionable whether
this makes any sense. There's also a closure which should retain the
Text::Textile object between invocations, potentially saving some time at
the expense of a little memory.
=cut
{ my %cache;
my $textile = undef;
sub textile_process {
my $replacement;
unless (defined $textile) {
# head_offset: use h1., h2. in Textile formatting:
$textile = Text::Textile->new( head_offset => 2 );
}
while ( $_[0] =~ m/(.*?)<\/textile>/sx ) {
my $block = $1;
if (exists $cache{$block}) {
$replacement = $cache{$block};
} else {
$replacement = $textile->process($block);
$cache{$block} = $replacement;
}
$_[0] =~ s/\Q$block\E<\/textile>/$replacement/sg;
}
}
}
=item eval_perl
Evaluate embedded Perl in a string, replacing blocks enclosed with tags
with whatever they return (well, evaluated in a scalar context). Modifies
a string in-place, so be careful.
Also handles simple ${variables}, replacing them (for now) from %DISPLAY_CONF
values.
=cut
sub eval_perl {
while ($_[0] =~ m/(.*?)<\/perl>/s) {
my $block = $1;
my $output = eval $block;
if ($@) {
# got an error
$_[0] =~ s/\Q$block\E<\/perl>/$@/s;
} else {
# include anything returned from $block
$_[0] =~ s/\Q$block\E<\/perl>/$output/s;
}
}
# interpolate variables
$_[0] =~ s/\${([a-zA-Z_]+)}/$DISPLAY_CONF{$1}/ge;
return;
}
=item image markup
Parse out an image tag and return the appropriate html.
=cut
sub image_markup {
my ($file, $block) = @_;
# get a directory for the file we're working with
$file =~ s'[^/]* # everything not a /
$ # up to end of string
''x;
# truncated file date that just includes date + sub docs
my ($file_date) = $file =~ m'([0-9]{4}/ # year
[0-9]{1,2}/ # month
[0-9]{1,2}/ # day
([a-z]*/)*)$ # sub-entries
'x;
my ($image_name, $alt_text, $title_text) = split /\n/, $block;
$title_text = $alt_text unless $title_text;
my $image_file;
if (-e "$file/$image_name" ) {
$image_file = "$file/$image_name";
$image_name = "${file_date}${image_name}";
} elsif (-e "$DISPLAY_CONF{ROOT_DIR}/$image_name") {
$image_file = "$DISPLAY_CONF{ROOT_DIR}/$image_name";
}
# get width & height in pixels for known filetypes
my ($width, $height) = image_size($image_file);
# may need to change this if rewrites don't work
return qq||;
}
=item month_name
Turn numeric dates into English.
=cut
sub month_name {
my ($number) = @_;
# "Null" is here so that $month_name[1] corresponds to January, etc.
my @months = qw(Null January February March April May June
July August September October November December);
return $months[$number];
}
=item feed_print
Dump out an Atom feed of entries for a month.
Called from handle(), requires XML::Atom::SimpleFeed.
=cut
sub feed_print {
my $month = shift;
# create a feed object
my $feed = XML::Atom::SimpleFeed->new(
title => $DISPLAY_CONF{title},
link => $DISPLAY_CONF{URL_ROOT},
link => { rel => 'self', href => $DISPLAY_CONF{feed_url}, },
icon => $DISPLAY_CONF{favicon_url},
author => $DISPLAY_CONF{author},
id => $DISPLAY_CONF{URL_ROOT},
);
# If a directory exists for $month, use dir_list to grab
# the entry files it contains into @entry_files, sorted
# numerically. Then send each entry to entry_print.
my @entry_files;
if (-d "$DISPLAY_CONF{ROOT_DIR}/$month") {
(@entry_files) = dir_list ("$DISPLAY_CONF{ROOT_DIR}/$month",
'high_to_low',
qr/^[0-9]{1,2}$/);
} else {
return 0;
}
foreach my $entry_file (@entry_files) {
# Going to feed this to SimpleFeed.
my $content = entry_print("$month/$entry_file");
$feed->add_entry(
title => "$month/$entry_file",
link => $DISPLAY_CONF{URL_ROOT} . "$month/$entry_file",
id => $DISPLAY_CONF{URL_ROOT} . "$month/$entry_file",
content => $content,
);
}
print "Content-type: application/atom+xml\n\n";
$feed->print;
return 1;
}
=item entry_markup
Return text wrapped in the appropriate markup for an entry. Just a wrapper
around div() at the moment.
=cut
sub entry_markup {
my ($text) = @_;
return div($text, 'entry') . "\n";
}
=item div
Return text wrapped in a div of the specified class.
=cut
sub div {
my ($text, $class) = @_;
my ($top, $result);
if ($class) {
$top = "
\n";
} else {
$top = "
\n";
}
return ( $top . $text . "\n
\n" );
}
=item a
Returns an HTML link.
=cut
sub a {
my ($url, $text) = @_;
return "$text";
}
=item ornament
Returns a type ornament.
=cut
sub ornament {
return '§';
}
=item image_size
Returns (width, height) of a variety of image files. Called by icon_markup and
line_parse. Uses Image::Size if available, otherwise uses a couple of built-in
routines munged together from pngsize and jpegsize in wwwis, by Alex Knowles
and Andrew Tong.
=cut
sub image_size {
my ($image_file) = shift;
# Use Image::Size - this needs to be actually conditionalized.
my ($x, $y, $type);
($x, $y, $type) = imgsize($image_file);
return ($x, $y);
# Otherwise we want to use our built-in routines:
my ($head);
if ( !open(IMAGE, '<', $image_file) ) {
print STDERR "can't open IMG $image_file";
return (0, 0);
} else {
binmode IMAGE;
if ($image_file =~ m/\.png$/) { # it's a PNG
my ($a, $b, $c, $d, $e, $f, $g, $h) = 0;
if (defined($image_file)
&& read(IMAGE, $head, 8) == 8
&& ($head eq "\x8a\x4d\x4e\x47\x0d\x0a\x1a\x0a" ||
$head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a")
&& read(IMAGE, $head, 4) == 4
&& read(IMAGE, $head, 4) == 4
&& ($head eq "MHDR" || $head eq "IHDR")
&& read(IMAGE, $head, 8) == 8) {
# ($x, $y) = unpack("I"x2, $head);
# doesn't work on little-endian machines
# return ($x,$y);
($a,$b,$c,$d,$e,$f,$g,$h) = unpack ("C"x8, $head);
return ($a<<24|$b<<16|$c<<8|$d, $e<<24|$f<<16|$g<<8|$h);
}
} elsif ($image_file =~ m/\.jpe?g$/) { # it's a JPEG
my($done) = 0;
my($c1,$c2,$ch,$s,$length, $dummy) = (0,0,0,0,0,0);
my($a,$b,$c,$d);
if (defined($image_file)
&& read(IMAGE, $c1, 1)
&& read(IMAGE, $c2, 1)
&& ord($c1) == 0xFF
&& ord($c2) == 0xD8) {
while (ord($ch) != 0xDA && !$done) {
# Find next marker (JPEG markers begin with 0xFF)
# This can hang the program!!
while (ord($ch) != 0xFF) {
return(0,0) unless read(IMAGE, $ch, 1);
}
# JPEG markers can be padded with unlimited 0xFF's
while (ord($ch) == 0xFF) {
return(0,0) unless read(IMAGE, $ch, 1);
}
# Now, $ch contains the value of the marker.
if ((ord($ch) >= 0xC0) && (ord($ch) <= 0xC3)) {
return(0,0) unless read (IMAGE, $dummy, 3);
return(0,0) unless read(IMAGE, $s, 4);
($a,$b,$c,$d)=unpack("C"x4,$s);
return ($c<<8|$d, $a<<8|$b );
} else {
# We **MUST** skip variables, since FF's within
# variable names are NOT valid JPEG markers
return(0,0) unless read (IMAGE, $s, 2);
($c1, $c2) = unpack("C"x2,$s);
$length = $c1<<8|$c2;
last if (!defined($length) || $length < 2);
read(IMAGE, $dummy, $length-2);
}
}
}
}
return (0,0);
}
}
=back
=head1 SEE ALSO
walawiki.org, Blosxom, rassmalog, Text::Textile, XML::Atom::SimpleFeed,
Image::Size, CGI::Fast.
=head1 AUTHOR
Copyright 2001-2007 Brennen Bearnes
Image sizing code (in image_size) derived from wwwis, by Alex Knowles and
Andrew Tong.
display.pl is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
=cut
1;