#!/usr/bin/perl
###########################################################################
# rss_display.cgi:
#    Render an RSS URL as an HTML fragment.
#
# Maintained by l.m.orchard <deus_x@pobox.com> http://www.decafbad.com
# Charset support by Klaus Johannes Rusch http://www.atmedia.net/KlausRusch/
#
# This program 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, published at
# http://www.gnu.org/copyleft/gpl.html
###########################################################################

use strict;
use Data::Dumper qw(Dumper);
use XML::RSS;
use LWP::Simple;
use CGI;
use MD5;

### Global config
my $HOME      = ".";
my $cache_dir = "cache";

### Initialize
my $q = new CGI();

### Get parameters from URL query
my %params;
$params{rss_src_url}       = $q->param("src")          ||
  "http://www.livejournal.com/customview.cgi?user=deus_x&styleid=32679";
$params{rss_max_items}       = $q->param("max_items")    || 10;
$params{rss_item_class}       = $q->param("item_class")   || "rss_item";
$params{rss_update_class}  = $q->param("update_class") || "rss_update";
$params{rss_title_class}   = $q->param("title_class")  || "rss_title";
$params{rss_link_class}       = $q->param("link_class")   || "rss_link";
$params{rss_xml_img}       = $q->param("xml_img")      ||
  "http://www.decafbad.com/images/xml.gif";
$params{debug}             = $q->param('debug');
$params{cache_age}          = $q->param("cache_age")    || 3600;

### Come up with a cache filename which changes based on changes in
### supplied options.  This is a big ugly hack.  Suggestions welcome.
my $cache_signature = join
  (":",
   ("rss_display", $params{rss_src_url}, $params{rss_max_items},
    $params{rss_item_class}, $params{rss_update_class},
    $params{rss_title_class}, $params{rss_link_class},
    $params{rss_xml_img})
  );

### Perform & display the results
my ($out) = perform_with_cache(\%params, \&rss_display, $cache_dir, $cache_signature);
print $q->header(-charset => 'UTF-8');
print $out;

exit (0);

###########################################################################

sub rss_display {
    my $params = shift;
    my $out;
    
    ### Try to get a fresh copy of the RSS and reset the modtime
    my $rss_src     = get($params->{rss_src_url});

    ### Attempt to parse the RSS file
    my $rss;
    eval {
        $rss = new XML::RSS;
        $rss->parse($rss_src);
    };

    ### I really wish I was using exceptions.
    if ($@) {
        $out = qq^
            <div class="$params->{rss_item_class}">
                <p>(Problem parsing this channel. See debug.)</p>^;
        #if ($params->{'debug'}) {
            $out .= qq^
                <pre>
                $$params->{rss_src_url}
                $@

                $$params->{rss_src}
                </pre>
            ^;
        #}
        $out .= qq^</div>^;
    } else {
        ### Render the RSS header as HTML
        $out = qq^<div class="$params->{rss_title_class}">^;
        $out .= qq^<a href="$rss->{channel}->{link}" class="$params->{rss_link_class}">^;
        my $title = $rss->{channel}->{title};
        if ($title eq '') { $title = "(untitled)"; }
        $out .= qq^$title</a>^;
        $out .= qq^ (<a href="$params->{rss_src_url}" class="$params->{rss_link_class}"><img src="$params->{rss_xml_img}"></a>)^;
        $out .= qq^</div>^."\n";
        $out .= qq^<div class="$params->{rss_update_class}">Last scanned: ^;
        $out .= scalar(localtime());
        $out .= "</div>\n";
        $out .= qq^<ul class="$params->{rss_item_class}">^."\n";

        ### Render the RSS items as HTML
        my $cnt = 0;
        foreach my $item (@{$rss->{items}}) {
            ### Generate a list item and link for the item's title.
            $out .= qq^\t<li class="$params->{rss_item_class}">^;
            $out .= qq^<a class="$params->{rss_item_class}" href="$item->{link}">^;
            my $title = $item->{title};
            if ($title eq '') { $title = "(untitled)"; }
            $out .= $title;
            $out .= "</a>";
            $out .= "</li>\n";

            ### Stop rendering if we're at the maximum items.
            $cnt++; last if ($cnt >= $params->{rss_max_items});
        }
        $out .= "</ul>\n";
    }

    return $out;
}

###########################################################################

sub perform_with_cache {
    my ($params, $sub_to_perform, $cache_dir, $cache_signature) = @_;

    my $cache_fn         = "$cache_dir/".MD5->hexhash($cache_signature);
    #my $cache_fn         = "$cache_dir/".CGI::escape($cache_signature);
    my $cache_modtime     = (stat($cache_fn))[9];

    ### If the cached file is too old, re-render
    my $out;
    if ( (time() - $cache_modtime) > $params->{cache_age} ) {
        $cache_modtime = time();
        $out = $sub_to_perform->($params);

        unlink($cache_fn);
        open(FOUT, ">$cache_fn");
        print FOUT $out;
        close(FOUT);
    }

    ### If cache not too old, just use the cached rendering
    else {
        local $/ = undef;
        open(FIN, "$cache_fn");
        $out = <FIN>;
        close(FIN);
    }

    # Remove XML declaration from cached copies
    $out =~ s/<\?xml [^>]*encoding="(.+?)"\?>\n//so;

    return ($out);
}