wrt/display.pl

#!/usr/bin/perl

=pod

=head1 NAME

display.pl - script to display fragments of text on the web
used at http://p1k3.com/
development version, spring 2007

=head1 DESCRIPTION

Entries are stored in a simple directory tree under $ROOT_DIR.

Like:

     2001/1/1

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, though I can'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 corresponding entry file.

=head1 MARKUP

Entries may consist of hand-written HTML, one of the forms of lightweight
markup understood by the script, or a 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.

Embedded Perl - replaced by whatever value you return:

     <perl>my $dog = "Ralph."; return $dog;</perl>

Interpolate variables - actually keys to %TEMPLATE, for the moment:

     <perl>$TEMPLATE{dog} = "Ralph"; return '';</perl>
     <p>My dog is named ${dog}.</p>

The Perl and embedded variables are intended for use in header and footer
files, where it's handy to drop in things like titles and conditionalize
aspects of the layout.  You might want to be careful with this sort of thing -
it's handy in small doses, but it's probably also a maintainability nightmare
waiting to happen.  (WordPress, I am looking at you.)

Several forms of lightweight markup:

     <wala>Wala::Markup, via Wala.pm - basic wiki syntax</wala>

     <textile>Dean Allen's Textile, via Brad Choate's Text::Textile.</textile>

     <freeverse>An easier way to
     get properly broken lines
     -- and em dashes --
     for poetry and such.</freeverse>

And a couple of shortcuts:

     <image>filename.(jpg|png)
     alt text, if any</image>

     <list>
     one list item
     
     another list item
     </list>

=head1 AUTHOR

Copyright 2001-2005 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

use strict;
use warnings;
no warnings 'uninitialized';

use lib 'lib';
use lib 'wala';

# eventually want to trap any errors here
  use Text::Textile;
  use XML::Atom::SimpleFeed;

  use Wala qw (%WalaConf %DISPLAY_CONF);
  Wala::eval_file("wala/conf.pl");
  $WalaConf{'ShowSearchlinks'} = 0;

# this stuff should all be subsumed into a general configuration
# file, first thing.

  # set the root directory for archived files
  my $ROOT_DIR = "/home/bbearnes/p1k3.com/archives";

  # and the root URL the world will see on the server
  # (normally "/", or "/~username/")
  # these should be used in all links in place of hard coded references
  my $URL_ROOT = "http://p1k3.com/";
  my $IMAGE_URL_ROOT = "http://p1k3.com/";

  # this is for Brent's wala script; a wiki implementation with a few
  # features targetted for discussion board use
  my $WALA_ROOT =  $WalaConf{'PagesDir'};
  my $WALA_URL_ROOT = "http://p1k3.com/wala/wala.pl?";

# Get the time, format the couple of variables I'll actually use.
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday,
    $isdst) = localtime(time);
$mon++;
$year += 1900;

# Handy for turning numeric dates into English.
# "Null" is there so that $month_name[1] corresponds to January, etc.
# (perl starts index numbers at 0, not 1)
my @month_name = qw(Null January February March April May June
                 July August September October November December);

# grab the command line options, using "new" if none are provided
my @options = @ARGV;
unless ($options[0]) { $options[0] = $ENV{'QUERY_STRING'} };
unless ($options[0]) { $options[0] = 'new' };

# now that we have some metadata,
# set some variables to be used in fragment interpretation.
# (these get inserted down in line_parse(); this is less than ideal)
my %TEMPLATE;
$TEMPLATE{title} = join(' ', @options);
$TEMPLATE{stylesheet_markup} = '<link rel="stylesheet" href="http://p1k3.com/p1k3.css" />';
$TEMPLATE{favicon_url} = 'http://p1k3.com/favicon.png';
$TEMPLATE{favicon_markup} = qq|<link rel="icon" type="image/x-png" href="$TEMPLATE{favicon_url}" />|;

# we're sending some HTML down the pipe
#print "Content-type: text/html\n\n";
# Currently taking care of this in the header file...

# Unless this is already in an HTML document, spit out some default HTML.
my $doc_uri = $ENV{'DOCUMENT_URI'};
my $print_footer = 0;
unless ( ( $doc_uri =~ m/html$|feed$/ ) or ( $options[0] eq 'feed' ) ) {
    print fragment_slurp("/home/bbearnes/p1k3.com/header");
    $print_footer = 1;
}

# take care of "all" alias in options
# get everything in the archive root directory
my @old_options = @options;
for (@old_options) {
    if ($_ eq 'all') {
        push (@options, dir_list ($ROOT_DIR,
                                  "high_to_low",
                                  "^[0-9]{1,4}\$") );
    }
}

# For each option provided, take the appropriate action.
# most often there will only be one option
# but it's good to keep this open

foreach my $option (@options) {
    # take care of trailing slashes
    chop ($option) if (substr($option, -1, 1) eq '/');
    
    # This just provides an alias for the most recent month.
    if ($option =~ m/^(feed|new)/) {
        my $special = $1;

        if (-e "$ROOT_DIR/$year/$mon") {
            $option = "$year/$mon";
        } else {
            my (@year_files) = dir_list ("$ROOT_DIR",
                                         'high_to_low',
                                         '^[0-9]{1,4}$');

            my (@month_files) = dir_list ("$ROOT_DIR/$year_files[0]",
                                          'high_to_low',
                                          '^[0-9]{1,2}');

            $option = "$year_files[0]/$month_files[0]";
        }

        # Handle feed generation using XML::Atom::SimpleFeed.
        if ($special eq 'feed') {
            feed_print($option);
            exit;
        }
    }

    if ( $option =~ m'^[0-9/]{5,11}[a-z_/]+$' ) {
        # nnnn/[nn/nn/]doc_name
        # It's a document within a date.  entry_print it.
        print entry_markup(entry_print($option, 'index') . datestamp($option));
    }
    
    elsif ( $option =~ m'^[0-9]{4}/[0-9]{1,2}/[0-9]{1,2}$' ) {
        # nnnn/nn/nn
        # It's a specific date.  Print it in full.
        print 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.
        month_print($option);
    }
    
    elsif ( $option =~ m'^[0-9]{4}$' ) {
        # nnnn - It's a year. Display a list of entries.
        year_print($option);
    }

    elsif ($option =~ m'^[a-z_]') {
        # assume it's a document in the root directory
        print entry_markup(entry_print($option, 'all'));
    }
}

# Finish up...
# Print a footer.
if ($print_footer) {
    print fragment_slurp("/home/bbearnes/p1k3.com/footer");
}

# Fini.

# Everything that follows is a subroutine.  For no bigger than this thing is,
# there are an awful lot of them and it can get a little convoluted.

# ---------------------------------------------------------------------
# | Subroutines...                                                    |
# ---------------------------------------------------------------------

# dir_list:
# Return a $sort_order sorted list of files matching $pattern in a
# directory.  Called by year_print, month_print, and entry_print.

# calls $sort_order, which can be one of
#   alpha - alphabetical 
#   reverse_alpha - alphabetical, reversed (might not work yet)
#   high_to_low - numeric, high to low
#   low_to_high - numeric, low to high

sub dir_list {
    my ($dir, $sort_order, $file_pattern) = @_;
    my (@files);
    
    $file_pattern = "^[0-9]{1,2}\$" unless ($file_pattern);
    $sort_order = "high_to_low" unless ($sort_order);

    opendir LIST_DIR, $dir;
    @files = grep /$file_pattern/, readdir LIST_DIR;
    closedir LIST_DIR;

    @files = sort $sort_order @files;

    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


# year_print: list out the updates for a year
# calls dir_list, entry_print
sub year_print {
    my ($year) = @_;
    my (@update_files, $update_count, $ico_markup);

    if (-d "$ROOT_DIR/$year") {
        print '<div class="entry">' . "\n";

        if (-T "$ROOT_DIR/$year/index") {
            print entry_print($year, 'index');
        }
        
        if ( $ico_markup = icon_markup($year, $year) ) { 
            print "<h3>$ico_markup $year</h3>";
        } else {
            print "<h3>$year</h3>\n";
        }

        my @month_files = dir_list ("$ROOT_DIR/$year",
                                 "high_to_low",
                                 "^[0-9]{1,2}\$");

        print "\n<table>\n";
        $update_count = 0;
        foreach my $month_file (@month_files) {
            @update_files = dir_list ("$ROOT_DIR/$year/$month_file",
                "low_to_high", "^[0-9]{1,2}\$");

            # Add the count of files to $update_count.
            $update_count += @update_files;
           
            print '<tr> <td class="datelink">'
                . a("$URL_ROOT$year/$month_file", $month_name[$month_file])
                . "</td> <td class=\"datelink\">\n";

            print "( <small>";

            foreach my $update_file (@update_files) {
                print a("$URL_ROOT$year/$month_file/$update_file", $update_file)
                    . "\n";
            }
            print "</small> )</td> </tr>\n\n";
        }
        print "</table>\n";

        print "<p>$update_count ";
        if ($update_count > 1) {
            my ($monthly_average) = int($update_count / @month_files);
            print " entries, an arithmetic mean of $monthly_average a month.";
        } elsif ($update_count == 0) {
            print " entries";
        } elsif ($update_count == 1) {
            print " entry";
        }
        print '</p>';

    } elsif (-T "$ROOT_DIR/$year") {
        print entry_print($year, 'index');
    } else {
        print '<p>No such year.</p>';
    }
    print "</div>\n";

    return ($update_count);
}

# month_print: print the entries in a given month (nnnn/nn)
# calls dir_list, datestamp
sub month_print {
    my ($year_digits, $month_digits, $calendar);
    # 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 ($month) = @_;

    if (-d "$ROOT_DIR/$month") {
        if (-T "$ROOT_DIR/$month/index") {
            print entry_print($month, "index");
        }

        my (@entry_files) = dir_list ("$ROOT_DIR/$month",
                                      "high_to_low",
                                      "^[0-9]{1,2}\$");
    
        foreach my $entry_file (@entry_files) {
           print entry_markup( entry_print("$month/$entry_file", 'index')
                               . datestamp("$month/$entry_file") );
        }
    } elsif (-T "$ROOT_DIR/$month") {
        print entry_print($month, 'index');
    }
}

# entry_print: print the contents of a given entry
# calls datestamp, fragment_print, dir_list, and icon_markup
# recursively calls itself
sub entry_print {
    my ($entry, $level) = @_;

    my ($result);

    my $entry_loc = "$ROOT_DIR/$entry"; # location of entry on local filesystem
    my $entry_url = $URL_ROOT . $entry; # and its URL
    
    # display an icon, if we have one.
    if ( my $ico_markup = icon_markup ($entry, "") ) {
            $result .= "<h2>$ico_markup</h2>\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");

        my @sub_entries = dir_list ($entry_loc, 'alpha',
                                 '^[a-z_]+(\.tgz|\.zip|\.tar\.gz)?$');
      
        # followed by any sub-entries
        if ( ($level eq 'index') and (@sub_entries > 1) ) {
            # if we're just supposed to print an index
            # spit out icons or text links for extra files
            my $contents;
            my %ignore_entries = ("index" => 1, "standing_bear" => 1);

            foreach my $sub_entry (@sub_entries) {
                next if ($ignore_entries{$sub_entry});

                if ( my $sub_ico_markup = icon_markup("$entry/$sub_entry", $sub_entry) ) { 
                    $contents .= qq|<a href="${URL_ROOT}$entry/$sub_entry" |
                               . qq|title="$sub_entry">$sub_ico_markup</a>\n |;
                } else {
                    $contents .= qq|<a href="${URL_ROOT}$entry/$sub_entry "|
                               . qq|title="$sub_entry">$sub_entry</a> \n|;
                }
            }

            $result .= "<p><em><strong>more</strong></em>: $contents</p>\n";
        } elsif ( ($level eq 'all') and (@sub_entries > 1) ) {

            # but if we're supposed to print everything in the directory
            # and if there's more there than just the index file,

            foreach my $sub_entry (@sub_entries) {
                next if ($sub_entry eq 'index'); # skip index
            
                # print each of the other files, separated by little headers
                $result .= "\n\n<p class=\"centerpiece\">{"
                         . a("${URL_ROOT}$entry/$sub_entry", $sub_entry)
                         . "}</p>\n\n";

                # skipping any archives
                next if ($sub_entry =~ m/(\.tgz|\.zip|\.tar\.gz)$/);

                $result .= entry_print("$entry/$sub_entry", 'index');
            }

        } 

    }

    return $result;
}

# 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
# called by entry_print
# calls image_size
# uses filename to determine type
sub icon_markup {
    my ($entry, $alt) = @_;
    my ($entry_loc) = "$ROOT_DIR/$entry";
    my ($entry_url) = "${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 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" />|;
}

# datestamp:
# returns a nice html datestamp for a given entry.
# including a wikilink for discussion and suchlike
# called by entry_print
sub datestamp {
    my ($entry, $markup_start, $markup_end) = @_;

    unless ($markup_start and $markup_end) {
        $markup_start = "\n<p class=\"datelink\">";
        $markup_end = "</p>\n\n";
    }

    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 "$WALA_ROOT/${wiki_date_name}") {
            $wikistamp = qq{:: <a title="a page you can edit"}
                    . qq{  href="${WALA_URL_ROOT}$wiki_date_name">read the margins</a>};
        } else {
            $wikistamp = qq{:: <a title="a page you can edit"}
                    . qq{  href="${WALA_URL_ROOT}$wiki_date_name">write in the margins</a>};
        }
           
        # return a fancy datestamp.

        $stamp = <<STAMP;
$markup_start
  <a href="$URL_ROOT$entry_year" title="$entry_year">$entry_year</a>
  <a href="$URL_ROOT$entry_year/$entry_month" title="$entry_year/$entry_month">$month_name[$entry_month]</a>
  <a href="$URL_ROOT$entry_year/$entry_month/$entry_day" title="$entry_year/$entry_month/$entry_day">$entry_day</a>
  $wikistamp
$markup_end
STAMP

    } else {
        $stamp = "$markup_start(failed to construct datestamp for $entry)$markup_end";
    }

    return ($stamp);
}

# fragment_print: print a text fragment - a header, footer, update, etc.
# called by main routines
# used to print headers and footers
# calls fragment_slurp to get the fragment it's supposed to print.
# returns 1 on successful completion, 0 otherwise
sub fragment_print {
    my ($file) = @_;

    my $lines = fragment_slurp($file);

    if (length($lines)) {
        print $lines;
    } else {
        return '';
    }
}

# 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.
# called by entry_print, at least
sub fragment_slurp {
    my ($file) = @_;

    # if $file is text
    if (-T $file) {
        my $everything;
    
        open (my $fh, '<', $file) or return '';
        {
            # line sep
            local $/ = undef;
            $everything = <$fh>;
        }
        close $fh;

        # take care of any special markup
        # we feed $file to line_parse so it has some context to work with
        $everything = line_parse ($file, $everything);

        return $everything;
    } else {
        return '';
    }
}

# line_parse: performs substitutions on lines
# called by fragment_slurp, at least
# calls image_markup, Text::Textile, Wala::wiki_page_to_html, eval_perl
# returns string
#
# parses some special markup, specifically:
#     <perl>embedded perl</perl>
#     ${variable} interpolation from %TEMPLATE
#     <textile></textile> - Text::Textile to HTML
#     <wala></wala> - Wala::wikify();
#     <image>filename.(jpg|png)</image>
#     <freeverse></freeverse>
#     <retcon></retcon>
#     <list></list>

sub line_parse {
    my ($file, $everything) = (@_);

    # eval embedded Perl
    $everything = eval_perl($everything, $file);

    # interpolate variables
    $everything =~ s/\${([a-zA-Z_]+)}/$TEMPLATE{$1}/ge;

    # take care of wala markup
    $everything =~ s/<wala>(.*?)<\/wala>/Wala::wikify($1)/seg;

    # take care of textile markup, if we've got any
    # this is wrapped in a conditional to keep from
    # creating the object if we don't need it.
    if ($everything =~ m/<textile>/s) {
        # head_offset: use h1., h2. in Textile formatting.
        my $textile = Text::Textile->new( head_offset => 2 );

        $everything =~ s/<textile>(.*?)<\/textile>/$textile->process($1)/seg;
    }

    # evaluate <image> tags.
    $everything =~ s!<image>(.*?)</image>!image_markup($file, $1)!seg; 

    my %tags = ( retcon => 'div class="retcon"',
                 freeverse => 'p',
                 list => "ul>\n<li" );

    my %end_tags = ( retcon => 'div',
                     freeverse => 'p',
                     list => 'li></ul' );

    my %blank_lines = ( freeverse => "</p>\n\n<p>",
                        list => "</li>\n\n<li>" );

    my %newlines = ( freeverse => "<br />\n" );

    my %dashes = ( freeverse => ' &mdash; ' );

    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 --
            # the \Q and \E escape any regex chars in 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}(\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;
}


# eval embedded Perl, replacing blocks enclosed with <perl> tags
# with whatever they return.
sub eval_perl {
    my ($everything, $file) = @_;

    while ($everything =~ m/<perl>(.*?)<\/perl>/s) {
        my $block = $1;

        my $output = eval $block;
        if ($@) {
          # got an error
          $everything =~ s/<perl>\Q$block\E<\/perl>/$@ in $file/s;
        } else {
          # include anything returned from $block
          $everything =~ s/<perl>\Q$block\E<\/perl>/$output/s;
        }
    }

    return $everything;
}


# image markup: parse out an image tag,
# return the appropriate html.
# calls image_size
# called by line_parse
sub image_markup {
    my ($file, $block) = @_;
        
    # get a directory for the file we're working with
    $file =~ s'[^/]*$'';

    # truncated file date that just includes date + sub docs
    my ($file_date) = $file =~ m'([0-9]{4}/[0-9]{1,2}/[0-9]{1,2}/([a-z]*/)*)$';

    my ($image_name, $alt_text) = split("\n", $block);

    my $image_file;
    if (-e "$file/$image_name" ) {
        $image_file = "$file/$image_name";
        $image_name = "${file_date}${image_name}";
    } elsif (-e "$ROOT_DIR/$image_name") {
        $image_file = "$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|<img src="${IMAGE_URL_ROOT}$image_name"\n height="$height"|
         . qq|\n width="$width"\n alt="$alt_text" />|;
}


# ornament: returns an img tag string pointing to a type ornament.
# called by entry_print
sub ornament {
    return '<small>&sect;</small>';
}


# feed_print: # dump out an atom feed of entries
# right now this is a ghetto copy 'n paste of month_print
# called from main conditional statement
# calls entry_print, uses XML::Atom::SimpleFeed 
sub feed_print {
    my $month = shift;

    # create a feed object
    my $feed = XML::Atom::SimpleFeed->new(
        title   => 'p1k3::new',
        link    => 'http://p1k3.com/',
        link    => { rel => 'self', href => 'http://p1k3.com/feed', },
        icon    => $TEMPLATE{favicon_url},
        author  => 'Brennen Bearnes',
        id      => 'http://p1k3.com/',
    );


    # 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 "$ROOT_DIR/$month") {
        (@entry_files) = dir_list ("$ROOT_DIR/$month", "high_to_low",
                "^[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", 'index');

        $feed->add_entry(
            title     => "$month/$entry_file",
            link      => $URL_ROOT . "$month/$entry_file",
            id        => $URL_ROOT . "$month/$entry_file",
            content   => $content,
        );     

    }

    print "Content-type: application/atom+xml\n\n";
    $feed->print;
    return 1;

}


# Return text wrapped in the appropriate markup for an entry.
sub entry_markup {
    my ($text) = @_;
    return div($text, 'entry');
}


# Return text wrapped in a div of the specified class.
sub div {
    my ($text, $class) = @_;
    my ($top, $result);

    if ($class) {
        $top = "<div class=\"$class\">\n";
    } else {
        $top = "<div>\n";
    }

    return ( $top . $text . "\n</div>\n" );
}

# This may be ill-advised.
sub a {
    my ($url, $text) = @_;

    return "<a href=\"$url\">$text</a>";
}

# image_size : returns (width, height) of a PNG or JPEG file.
# munged together from pngsize and jpegsize
# in wwwis, by Alex Knowles and Andrew Tong
# see http://www.bloodyeck.com/wwwis/
# any weirdness here is probably my fault, not theirs.

# called by icon_markup
sub image_size {
    my ($image_file) = shift;

    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);
    } 
}