RSS Feed content provider for Perl Mongers

[zeno]

I recently was looking for ideas to improve the Barcelona Perl Mongers web page and came across an item in the Perl Mongers FAQ about a couple of RSS feeds which could be used to provide dynamic content to the page. This script does that-- it currently is being used at http://barcelona.pm.org/news.cgi, slightly modified.

The script does not attempt to fix bad RSS feeds-- first off because the feeds I'm using seem to be okay, and secondly because I don't like the idea of fixing them (I mean, that would defeat the purpose of the RSS, no?

This script is written without HERE tags, but rather relying on the CGI.pm module.

Note: Depending on what version of XML::RSS you have on your server, you may need to take off the Carp code for this to work-- I also had to take off Taint (-T on the first line).

#!/usr/bin/perl -w -T
# rss_news.pl - Read from RSS Feeds and produce
# a web page.
# Note: This is not guaranteed to work on all
# RSS feeds.  It does not break on the ones listed.
# See this at work at
# http://barcelona.pm.org/news.cgi

use strict;

use XML::RSS;
use LWP::Simple qw(get);
use CGI qw(:standard escapeHTML);
# warningsToBrowser may not work in your version--
# if so, use comment this declaration and use the
# next one. Also, remove the fatalsToBrowser for a
# production site if you're worried about
# security.
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
#use CGI::Carp qw(fatalsToBrowser);

my $cgi = new CGI; # Hash reference
print $cgi->header()."\n\n";
# If warningsToBrowser doesn't work in your version,
# comment the next line.
warningsToBrowser(1);
print $cgi->start_html("news feeds")."\n\n";

# Read and process the channels listed at the
# end of the file.
my @channels;
while (<DATA>)
{
    push(@channels, $_);
}
map {get_channel($_, $cgi)} (@channels);

print $cgi->end_html()."\n";

sub get_channel
{
    # This subroutine takes a URL and a CGI object
    # and prints out the resulting RSS feed formatted
    # as HTML

    my ($url, $q) = @_;
    my $version = "1.0";

    # Use LWP::Simple to get the RSS feed.
    my $content = get($url) or carp("I couldn't get from $url");
    # Just to be sure...
    if ($content =~ m/^\s*$/)
    {
        carp("$url is empty");
        return;
    }

    # Determine the version based on regexes-- 
    # I based these on the feeds I was familiar
    # with, so this part could be improved by
    # finding the standard for this information
    if ($content =~ m#http://my.netscape.com/rdf/simple/0.9/#i)
    {
        $version = "0.9";
        print $q->comment("$url: RDF version 0.9")."\n";
    }
    elsif ($content =~ m#<rss version="0.91">#i)
    {
        $version = "0.91";
        print $q->comment("$url: RDF version 0.91")."\n";
    }
    else
    {
        print $q->comment("$url: looks like RDF version 1.0")."\n";
    }
    # Create the new rss object with this version
    my $result = new XML::RSS (version => "$version");

    # Parse the content
    $result->parse($content) or carp("I couldn't parse $url");

    # Channel Title
    my $channel = $result->{'channel'}; # Hash reference
    print $q->comment("This page was generated from $url.")."\n\n";
    print $q->h1("News from ".
        $q->a( { -href => $channel->{'link'}},
        $channel->{'title'}))."\n";
    print $q->h2($channel->{'description'})."\n";

    # Channel Image
    my $image = $result->{'image'}; # Hash reference
    if ($image->{'title'} ne "")
    {
        print $q->a( { -href => $image->{'link'}},
            img( { -src => $image->{'url'},
            -alt => $image->{'title'}}))."\n\n";
    }

    # Channel Items
    my $tcontent = "";
    my $items = $result->{'items'}; # Array reference
    map {
        $tcontent .= $q->Tr(
            $q->td(
                $q->a(
                    { -href => $_->{'link'}},
                    $_->{'title'}
                )
            )
        )."\n"
    } (@{$items});
    print $q->table($tcontent)."\n\n";

    # Channel Search Form
    my $textinput = $result->{'textinput'}; # Hash Reference
    if ($textinput->{'link'} ne "")
    {
        print $q->h2($textinput->{'description'})."\n";
        print $q->start_form( {-action => $textinput->{'link'}} )."\n"
+;
        print $q->input( {-name => $textinput->{'name'}} )."\n";
        print $q->input( {-type => "submit",
                -value => $textinput->{'title'} || "Search"})."\n";
        print $q->end_form()."\n\n";
    }
}
__DATA__
http://use.perl.org/useperl.rdf
http://search.cpan.org/recent.rdf
http://www.xml.com/cs/xml/query/q/19
http://www.perlmonks.org/headlines.rdf

--
Zeno - Barcelona Perl Mongers http://barcelona.pm.org
http://www.javajunkies.org