brennen
/
wrt
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 27 Wiki Activity
Almost-minimal filesystem based blog.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
55 Commits
1 Branch
2.2 MiB
 
 
 
Tree: 2007-09-11
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from '2007-09-11'
${ noResults }
wrt/Display.pm

884 lines
22 KiB
Raw Permalink Blame History

#!/usr/bin/perl
=pod
=head1 NAME
Display - module to display fragments of text on the web and elsewhere
=head1 SYNOPSIS
#!/usr/bin/perl
use Display qw(%WalaConf %DISPLAY_CONF &handle);
do 'conf.pl' if -e 'conf.pl'; # grab config
$WalaConf{'ShowSearchlinks'} = 0;
print handle(@ARGV);
=head1 DESCRIPTION
Display started life as a simple script to concatenate fragments of handwritten
HTML by date. It has since haphazardly accumulated several of the usual weblog
features (comments, lightweight markup, feed generation, embedded Perl, poetry
tools, ill-advised dependencies), but the basic idea hasn't changed much.
The module will 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<Embedded Perl> - evaluated and replaced by whatever value you return
(evaluated in a scalar context):
<perl>my $dog = "Ralph."; return $dog;</perl>
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<Interpolated variables> - actually keys to %TEMPLATE, for the moment:
<perl>$TEMPLATE{dog} = "Ralph"; return '';</perl>
<p>My dog is named ${dog}.</p>
Embedded code and variables are mostly intended for use in F<header> and
F<footer> files, where it's handy to drop in titles or conditionalize aspects
of a layout. You want to be careful with this sort of thing - it's useful in
small doses, but it's also a maintainability nightmare waiting to happen.
(WordPress, I am looking at you.)
B<Several forms of lightweight markup>:
<wala>Wala::Markup, via Wala.pm - very basic wiki syntax</wala>
<textile>Dean Allen's Textile, via Brad Choate's
Text::Textile.</textile>
<freeverse>An easy way to
get properly broken lines
-- en and em dashes ---
for poetry and such.</freeverse>
B<And a couple of shortcuts>:
<image>filename.ext
alt text, if any</image>
<list>
one list item
another list item
</list>
As it stands, freeverse, image, and list are not particularly robust.
=cut
package Display;
use strict;
use warnings;
no warnings 'uninitialized';
BEGIN {
use base qw(Exporter);
our @EXPORT_OK = qw(%WalaConf %DISPLAY_CONF &handle);
use XML::Atom::SimpleFeed;
use Wala qw(%WalaConf %DISPLAY_CONF);
use Display::HTML qw(:highlevel);
use Display::Markup qw(line_parse);
use Display::Image qw(image_size);
}
our @EXPORT_OK;
######################
# DEFAULT OPTIONS #
######################
%DISPLAY_CONF = (
ROOT_DIR => 'archives', # root dir for archived files
URL_ROOT => 'http://p1k3.com/', # root URL for building links
IMAGE_URL_ROOT => 'http://p1k3.com/', # same for images
HEADER => 'header',
FOOTER => 'footer',
);
$WalaConf{'ShowSearchlinks'} = 0;
=head1 METHODS
For no bigger than this thing is, it gets a little convoluted.
=over
=item new
=cut
sub new {
my $class = shift;
my (@params) = @_;
my $self = {};
bless $self;
return $self;
}
=item handle
Handle a given request, either in the form of a CGI query object
or a date/entry string.
=cut
sub handle {
my (@options) = @_;
my $output;
# Get parameters from any CGI objects we've been given:
@options = map { expand_query($_) } @options;
# By default, we display the most recent month.
$options[0] = 'new' unless $options[0];
# Title for head/foot template:
$DISPLAY_CONF{title} = join ' ', @options;
# Maps 'all' and 'new' to appropriate entries:
@options = map { expand_option($_) } @options;
for my $o (@options) {
return feed_print() if $o eq 'feed';
$output .= output($o);
}
# Wrap entries in header/footer:
$output = fragment_slurp($DISPLAY_CONF{HEADER})
. $output
. fragment_slurp($DISPLAY_CONF{FOOTER});
return $output;
}
=item output
Returns appropriate output for a given option.
=cut
sub output {
my ($option) = @_;
if ( $option =~ m'^[0-9/]{5,11}[a-z_/]+$' ) {
# nnnn/[nn/nn/]doc_name
# It's a document within a date.
return entry_markup(entry_print($option) . datestamp($option));
}
elsif ( $option =~ m'^[0-9]{4}/[0-9]{1,2}/[0-9]{1,2}$' ) {
# nnnn/nn/nn - A specific date. Print it in full.
return entry_markup(entry_print($option, 'all') . datestamp($option));
}
elsif ( $option =~ m'^[0-9]{4}/[0-9]{1,2}$' ) {
# nnnn/nn - It's a month. Print it.
return month_print($option);
}
elsif ( $option =~ m'^[0-9]{4}$' ) {
# nnnn - It's a year. Display a list of entries.
return year_print($option);
}
elsif ($option eq 'portfolio') {
return entry_print($option, 'all');
}
elsif ($option =~ m'^[a-z_]') {
# Assume it's a document in the root directory.
return entry_markup(entry_print($option, 'all'));
}
}
=item expand_query
Expands a CGI query (for example, one passed in from CGI::Fast) to an
appropriate list of parameters.
=cut
sub expand_query {
my ($option) = shift;
if ( (ref($option) eq 'CGI::Fast') or (ref($option) eq 'CGI')) {
return $option->param('keywords');
} else {
return $option;
}
}
=item expand_option
Expands/converts 'all' and 'new' to appropriate values.
=cut
sub expand_option {
my ($option) = shift;
# take care of trailing slashes
chop ($option) if (substr($option, -1, 1) eq '/');
if ($option eq 'all') {
return dir_list($DISPLAY_CONF{ROOT_DIR}, 'high_to_low',
qr/^[0-9]{1,4}$/);
} elsif ($option eq 'new') {
return recent_month();
} else {
return $option;
}
}
=item recent_month
Tries to find the most recent month in the archive.
If a year file is text, returns that instead.
=cut
sub recent_month {
my ($dir) = $DISPLAY_CONF{ROOT_DIR};
# Below replaces:
# my ($sec, $min, $hour, $mday, $mon,
# $year, $wday, $yday, $isdst) = localtime(time);
my ($mon, $year) = (localtime time)[4,5];
$mon++;
$year += 1900;
if (-e "$dir/$year/$mon") {
return "$year/$mon";
}
else {
my @year_files = dir_list($dir, 'high_to_low', qr/^[0-9]{1,4}$/);
if (-T "$dir/$year_files[0]") {
return $year_files[0];
}
my @month_files = dir_list("$dir/$year_files[0]", 'high_to_low',
qr/^[0-9]{1,2}$/);
return "$year_files[0]/$month_files[0]";
}
}
=item month_before
Return the month before the given month in the archive.
Very naive; there has got to be a smarter way.
=cut
{ my %cache; # cheap memoization
sub month_before {
my ($this_month) = @_;
if (exists $cache{$this_month}) {
return $cache{$this_month};
}
my ($year, $month) = ( $this_month =~ m/^ # start of string
([0-9]{4}) # 4 digit year
\/ #
([0-9]{1,2}) # 2 digit month
/x );
if ($month == 1) {
$month = 12;
$year = $year - 1;
} else {
$month--;
}
until (-e "$DISPLAY_CONF{ROOT_DIR}/$year/$month") {
if (! -d "$DISPLAY_CONF{ROOT_DIR}/$year") {
# give up easily
return 0;
}
# handle January:
if ($month == 1) {
$month = 12;
$year--;
next;
}
$month--;
}
return $cache{$this_month} = "$year/$month";
}
}
=item dir_list
Return a $sort_order sorted list of files matching regex $pattern in a
directory.
Calls $sort_order, which can be one of:
alpha - alphabetical
reverse_alpha - alphabetical, reversed
high_to_low - numeric, high to low
low_to_high - numeric, low to high
=cut
sub dir_list {
my ($dir, $sort_order, $file_pattern) = @_;
$file_pattern = qr/^[0-9]{1,2}$/ unless ($file_pattern);
$sort_order = 'high_to_low' unless ($sort_order);
opendir LIST_DIR, $dir
or die "Couldn't open $dir: $!";
my @files = sort $sort_order
grep { m/$file_pattern/ }
readdir LIST_DIR;
closedir LIST_DIR;
return @files;
}
# various named sorts for dir_list
sub alpha { $a cmp $b; } # alphabetical
sub high_to_low { $b <=> $a; } # numeric, high to low
sub low_to_high { $a <=> $b; } # numberic, low to high
sub reverse_alpha { $b cmp $a; } # alphabetical, reversed
=item year_print
List out the updates for a year.
=cut
sub year_print {
my ($year) = @_;
my ($year_file) = "$DISPLAY_CONF{ROOT_DIR}/$year";
my ($year_url) = "$DISPLAY_CONF{URL_ROOT}$year";
my $result;
if (-d $year_file) {
# Handle year directories with index files.
$result .= entry_print($year) if -T "$year_file/index";
# this is stupid:
my $header_text = icon_markup($year, $year);
$header_text = '' unless $header_text;
$result .= heading("$header_text $year", 3);
my @months = dir_list($year_file, 'high_to_low', qr/^[0-9]{1,2}$/);
my $year_text;
my $count = 0; # explicitly defined for later printing.
foreach my $month (@months) {
my @entries = dir_list("$year_file/$month", 'low_to_high',
qr/^[0-9]{1,2}$/);
# Add the count of files to $update_count:
$count += @entries;
my $month_text;
foreach my $entry (@entries) {
$month_text .= a("href: $year_url/$month/$entry", $entry) . "\n";
}
$month_text = small('(' . $month_text . ')');
my $link = a("href: $year_url/$month", month_name($month));
$year_text .= table_row(
table_cell('class: datelink', $link),
table_cell('class: datelink', $month_text)
) . "\n\n";
}
$result .= "\n\n" . table($year_text) . "\n";
if ($count > 1) {
my ($average) = int($count / @months);
$count = "$count entries, roughly $average an active month.";
}
elsif ($count == 0) { $count = $count . ' entries'; }
elsif ($count == 1) { $count = $count . ' entry'; }
$result .= p($count);
} elsif (-T $year_file) {
$result .= entry_print($year);
} else {
$result .= p('No such year.');
}
return entry_markup($result);
}
=item month_print
Prints the entries in a given month (nnnn/nn).
=cut
sub month_print {
my ($month) = @_;
my $month_file = "$DISPLAY_CONF{ROOT_DIR}/$month";
my $result;
# 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.
if (-d $month_file) {
if (-T "$month_file/index") {
$result .= entry_print($month);
}
my @entry_files = dir_list ($month_file, 'high_to_low',
qr/^[0-9]{1,2}$/);
foreach my $entry_file (@entry_files) {
$result .= entry_markup( entry_print("$month/$entry_file")
. datestamp("$month/$entry_file") );
}
} elsif (-T $month_file) {
$result .= entry_print($month);
}
$result .= p( 'class: centerpiece',
a("href: $DISPLAY_CONF{URL_ROOT}" . month_before($month), 'previous') ) . "\n\n";
return $result;
}
=item entry_print
Prints the contents of a given entry. Calls datestamp,
dir_list, and icon_markup. Recursively calls itself.
=cut
sub entry_print {
my ($entry, $level) = @_;
$level = 'index' unless $level;
# location of entry on local filesystem, and its URL:
my $entry_loc = "$DISPLAY_CONF{ROOT_DIR}/$entry";
my $entry_url = $DISPLAY_CONF{URL_ROOT} . $entry;
my $result;
# display an icon, if we have one:
if ( my $ico_markup = icon_markup($entry) ) {
$result .= heading($ico_markup, 2) . "\n\n";
}
if (-T $entry_loc) {
# is text, slurp it and return
return $result . fragment_slurp($entry_loc);
} elsif (-d $entry_loc) {
# print index as head
$result .= fragment_slurp("$entry_loc/index");
# followed by any sub-entries:
my @sub_entries = get_sub_entries($entry_loc);
if ( $level eq 'index' and @sub_entries >= 1 ) {
# spit out icons or text links for extra files
$result .= list_contents($entry, @sub_entries);
} elsif ( $level eq 'all' and @sub_entries >= 1 ) {
# or if we're supposed to print everything in the directory
# and if there's more there than just the index file,
foreach my $se (@sub_entries) {
next if ($se =~ m/[.](tgz|zip|tar[.]gz|gz|txt)$/);
# print each of the other files, separated by little headers
#my $url = "$DISPLAY_CONF{URL_ROOT}$entry/$se";
#$result .= "\n\n" . p('{' . a("href: $url", $se) . '}') . "\n\n";
$result .= p('class: centerpiece', '+');
$result .= entry_print("$entry/$se");
}
}
}
return $result;
}
sub get_sub_entries {
my $entry_loc = shift;
my $match = qr/^[a-z_]+(\.(tgz|zip|tar[.]gz|gz|txt))?$/;
my %ignore = ('index' => 1);
return grep { ! $ignore{$_} } dir_list ($entry_loc, 'alpha', $match);
}
sub list_contents {
my ($entry) = shift;
my (@entries) = @_;
my $contents;
foreach my $se (@entries) {
my $linktext = icon_markup("$entry/$se", $se);
$linktext = $se unless $linktext;
$contents .= ' ' . a("href: $DISPLAY_CONF{URL_ROOT}$entry/$se",
$linktext,
"title: $se");
}
return p( em('more') . ": $contents" ) . "\n";
}
=item icon_markup
Check if an icon exists for a given entry if so, return markup to include it.
Icons are PNG or JPEG image files following a specific naming convention:
index.icon.[png|jp(e)g] for directories
[filename].icon.[png|jp(e)g] for flat text files
Calls image_size, uses filename to determine type.
=cut
sub icon_markup {
my ($entry, $alt) = @_;
my ($entry_loc) = "$DISPLAY_CONF{ROOT_DIR}/$entry";
my ($entry_url) = "$DISPLAY_CONF{IMAGE_URL_ROOT}${entry}";
my ($icon_loc, $icon_url);
if (-T $entry_loc) {
$icon_loc = "$entry_loc.icon";
$icon_url = "$entry_url.icon";
}
elsif (-d $entry_loc) {
$icon_loc = "$entry_loc/index.icon";
$icon_url = "$entry_url/index.icon";
}
# put a list of icon image types to check for here
# (first one found will be used)
my (@suffixes) = qw(png gif jpg jpeg);
my $suffix = "";
for (@suffixes) {
if (-e "$icon_loc.$_") {
$suffix = $_;
last;
}
}
# fail unless there's a file with one of the above suffixes
return 0 unless $suffix;
# call image_size to slurp width & height from the image file
my ($width, $height) = image_size("$icon_loc.$suffix");
return qq{<img src="$icon_url.$suffix"\n width="$width" }
. qq{height="$height"\n alt="$alt" />};
}
=item datestamp
Returns a nice html datestamp for a given entry, including a wikilink for
discussion and suchlike.
=cut
sub datestamp {
my ($entry) = @_;
my ($stamp);
if ( $entry =~ m{(^[0-9]{4}/[0-9]{1,2}/[0-9]{1,2})} ) {
my ($entry_year, $entry_month, $entry_day) = split (/\//, $1);
# this stuff conditionalizes the wikilink
# so that if nothing exists, you wind up with an edit form
my ($wiki_date_name) = month_name($entry_month) .
"_${entry_day}_${entry_year}";
my $wikistamp = ':: ';
if (-e "$WalaConf{PagesDir}/${wiki_date_name}") {
$wikistamp .= a("href: $WalaConf{ScriptName}?$wiki_date_name",
'read the margins',
'title: a page you can edit');
} else {
$wikistamp .= a("href: $WalaConf{ScriptName}?$wiki_date_name",
'write in the margins',
'title: a page you can edit');
}
# return a fancy datestamp.
my $month_name = month_name($entry_month);
my $year_url = "href: $DISPLAY_CONF{URL_ROOT}$entry_year";
$stamp = "\n "
. a($year_url, $entry_year, "title: $entry_year") . "\n "
. a("$year_url/$entry_month", $month_name, "title: $entry_year/$entry_month") . "\n "
. a("$year_url/$entry_month/$entry_day", $entry_day, "title: $entry_year/$entry_month/$entry_day") . "\n "
. $wikistamp . "\n";
} else {
$stamp = "(failed to construct datestamp for $entry)";
}
return p('class: datelink', $stamp);
}
=item fragment_slurp
Read a text fragment, call line_parse to take care of funky markup and
interpreting embedded code, and then return it as a string. Takes one
parameter, the name of the file, and returns '' if it's not an extant text
file.
This might be the place to implement an in-memory cache for FastCGI or mod_perl
environments. The trick is that the line_parse() results for certain files
shouldn't be cached because they contain embedded code.
=cut
sub fragment_slurp {
my ($file) = @_;
# if $file is text
if (-T $file) {
my $everything;
open my $fh, '<', $file
or die "Couldn't open $file: $!\n";
{
# line sep
local $/ = undef;
$everything = <$fh>;
}
close $fh or die "Couldn't close: $!";
# eval embedded Perl and ${variables}:
eval_perl($everything);
# Take care of any special markup.
# We pass along $file so it has some context to work with
return line_parse ($everything, $file);
} else {
return q{};
}
}
=item eval_perl
Evaluate embedded Perl in a string, replacing blocks enclosed with <perl> 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>(.*?)<\/perl>/s) {
my $block = $1;
my $output = eval $block;
if ($@) {
# got an error
$_[0] =~ s/<perl>\Q$block\E<\/perl>/$@/s;
} else {
# include anything returned from $block
$_[0] =~ s/<perl>\Q$block\E<\/perl>/$output/s;
}
}
# interpolate variables
$_[0] =~ s/\${([a-zA-Z_]+)}/$DISPLAY_CONF{$1}/ge;
return;
}
=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
Return an Atom feed of entries for a month. Defaults to the most
recent month in the archive.
Called from handle(), requires XML::Atom::SimpleFeed.
=cut
sub feed_print {
my $month = shift;
$month = recent_month() unless defined $month;
# 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},
generator => "Display.pm / XML::Atom::SimpleFeed",
);
# 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,
);
}
return "Content-type: application/atom+xml\n\n"
. $feed->as_string;
}
=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;