wrt/Display.pm

#!/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<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';

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(%WalaConf %DISPLAY_CONF &handle);
our @EXPORT;

use Image::Size;
use Text::Textile;
use XML::Atom::SimpleFeed;
use Wala qw (%WalaConf %DISPLAY_CONF);

######################
#  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 SUBROUTINES

For no bigger than this thing is, it gets a little convoluted.

=over

=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;

    my $print_footer;
    unless ($options[0] eq 'feed') {
      # Spit out a header:
      $output .= fragment_slurp($DISPLAY_CONF{HEADER});
      $print_footer = 1;
    }

    foreach my $option (@options) {
      # Handle feed with XML::Atom::SimpleFeed:
      if ($option eq 'feed') {
        feed_print( recent_month() );
        last;
      }
      $output .= output($option);
    }

    $output .= fragment_slurp($DISPLAY_CONF{FOOTER}) if $print_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 =~ m'^[a-z_]') {
    # Assume it's a document in the root directory.
    return entry_markup(entry_print($option, 'all'));
  }

}


=item expand_query

Returns parameters if it's given a CGI object.

=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 {

    # Get the time, format the couple of variables I'll actually use.

    # my ($sec, $min, $hour, $mday, $mon,
    #     $year, $wday, $yday, $isdst) = localtime(time);

    my ($dir) = $DISPLAY_CONF{ROOT_DIR};
    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 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;

    #@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


=item year_print

List out the updates for a year.

=cut

sub year_print {
    my ($year) = @_;
    my $result;

    if (-d "$DISPLAY_CONF{ROOT_DIR}/$year") {

        if (-T "$DISPLAY_CONF{ROOT_DIR}/$year/index") {
            $result .= entry_print($year);
        }
        
        my $header_text = icon_markup($year, $year);
        $header_text = '' unless $header_text; # stupid
        $result .= "<h3>$header_text $year</h3>";

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

        $result .= "\n<table>\n";
        my $update_count = 0; # explicitly define for later printing.
        foreach my $month_file (@month_files) {
            my @update_files = dir_list ("$DISPLAY_CONF{ROOT_DIR}/$year/$month_file",
                'low_to_high', qr/^[0-9]{1,2}$/);

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

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

        $result .= "<p>$update_count ";

        if ($update_count > 1) {
            my ($monthly_average) = int($update_count / @month_files);
            $result .= " entries, roughly $monthly_average an active month.";
        }
        elsif ($update_count == 0) { $result .= " entries"; }
        elsif ($update_count == 1) { $result .= " entry"; }

        $result .= '</p>';

    } elsif (-T "$DISPLAY_CONF{ROOT_DIR}/$year") {
        $result .= entry_print($year);
    } else {
        $result .= '<p>No such year.</p>';
    }

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

    return $result;
}

=item entry_print

Prints the contents of a given entry. Calls datestamp, fragment_print,
dir_list, and icon_markup. Recursively calls itself.

=cut

sub entry_print {
    my ($entry, $level) = @_;
    $level = 'index' unless $level;
    my ($result);

    # 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;
    
    # 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',
                                    qr/^[a-z_]+(\.(tgz|zip|tar[.]gz|gz))?$/);
      
        # followed by any sub-entries:

        my %ignore_entries = ('index' => 1);

        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;

            foreach my $se (@sub_entries) {
                next if ($ignore_entries{$se});
                my $linktext = icon_markup("$entry/$se", $se);
                $linktext = $se unless $linktext;
                $contents .= qq{<a href="$DISPLAY_CONF{URL_ROOT}$entry/$se" }
                           . qq{title="$se">$linktext</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 $se (@sub_entries) {
                next if $ignore_entries{$se}; # skip stoplist
            
                # print each of the other files, separated by little headers
                $result .= "\n\n<p>{"
                         . a("$DISPLAY_CONF{URL_ROOT}$entry/$se", $se)
                         . "}</p>\n\n";

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

                $result .= entry_print("$entry/$se");
            }

        } 

    }

    return $result;
}

=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) = @_;
    $alt = '' unless $alt; # default to nothing
    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, $markup_start, $markup_end) = @_;

    unless ($markup_start and $markup_end) {
        $markup_start = "\n<p class=\"datelink\">";
        $markup_end = "</p>\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 "$WalaConf{PagesDir}/${wiki_date_name}") {
            $wikistamp = qq{:: <a title="a page you can edit"}
                       . qq{\n  href="$WalaConf{ScriptName}?$wiki_date_name">read the margins</a>};
        } else {
            $wikistamp = qq{:: <a title="a page you can edit"}
                    . qq{\n  href="$WalaConf{ScriptName}?$wiki_date_name">write in the margins</a>};
        }
           
        # return a fancy datestamp.

        my $month_name = month_name($entry_month);
        my $year_url = "$DISPLAY_CONF{URL_ROOT}$entry_year";
        $stamp = <<STAMP;
$markup_start
  <a href="$year_url"
     title="$entry_year">$entry_year</a>
  <a href="$year_url/$entry_month"
     title="$entry_year/$entry_month">$month_name</a>
  <a href="$year_url/$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);
}

=item 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.

=cut

sub fragment_print {
    my ($file) = @_;

    my $lines = fragment_slurp($file);

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

=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 return '';
        {
            # line sep
            local $/ = undef;
            $everything = <$fh>;
        }
        close $fh;

        # 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 '';
    }
}

=item 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 %DISPLAY_CONF
    <textile></textile> - Text::Textile to HTML
    <wala></wala> - Wala::wikify();
    <freeverse></freeverse>
    <retcon></retcon>
    <list></list>

    <image>filename.ext
    optional alt tag</image>

=cut

{   # Some useful definitions to have on hand. 
    my %tags = ( retcon    => 'div class="retcon"',
                 freeverse => 'p',
                 list      => "ul>\n<li" );

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

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

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

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

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

        # eval embedded Perl and ${variables}:
        eval_perl($everything);

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

        # take care of textile markup, if we've got any
        textile_process($everything);

        # evaluate <image> tags.
        $everything =~ s!<image>(.*?)</image>!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 <textile> 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>(.*?)<\/textile>/sx ) {
      my $block = $1;

      if (exists $cache{$block}) {
        $replacement = $cache{$block};
      } else {
        $replacement = $textile->process($block);
        $cache{$block} = $replacement;
      }

      $_[0] =~ s/<textile>\Q$block\E<\/textile>/$replacement/sg;
    }

  }
}

=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 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|<img src="$DISPLAY_CONF{IMAGE_URL_ROOT}$image_name"\n height="$height"|
         . qq|\n width="$width"\n alt="$alt_text"\n title="$title_text" />|;
}


=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 = "<div class=\"$class\">\n";
    } else {
        $top = "<div>\n";
    }

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


=item a

Returns an HTML link.

=cut

sub a {
    my ($url, $text) = @_;
    return "<a href=\"$url\">$text</a>";
}


=item ornament

Returns a type ornament.

=cut

sub ornament {
    return '<small>&sect;</small>';
}


=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;