#!/home/intute/perl/bin/perl

# RDN RSS viewer v2 
# Simple RSS viewer with templating
#
# Pete Cliff <p.d.cliff@ukoln.ac.uk> & Andy Powell <a.powell@ukoln.ac.uk>
# $Id: index.cgi,v 1.1 2004/05/15 09:03:40 rdn Exp $

# template, rss, layout, (output) format

use XML::RSS;
use XML::Atom::Feed;
use LWP::UserAgent;
use LWP;
use LWP::Protocol;
use CGI;
use URI::Escape;
use Unicode::String qw(utf8 latin1);
use HTML::Entities;     # added by Paul Smith 2008-07-25 to address entity encoding issues

my $cgi = new CGI;
my $tptag = "<PUTRSSHERE>";
my $tpuri = $cgi->param('template') || "";
my $rssuri = $cgi->param('rss');
my $layout = $cgi->param('layout') || "table";
#my $format = $cgi->param('format') || "html";
# this line changed Sat May 15 09:54:51 BST 2004 - AP
my $format = $cgi->param('format');
my $template;
unless ($tpuri eq "") {
	$template = readURL($tpuri) || $tptag;
} else {
	$template = $tptag;
}
# my $options = $cgi->param('options'); - one day this might get implemented... ;-)
if (defined $rssuri) {
	$rssuri =~ s/www\.intute\.ac\.uk\//www\.intute\.ac\.uk\//; # removed :8080 since moving out of web proxy to tintagel
  print "$rssuri\n";
  if ($rss = readURL($rssuri)) {
    CASE: {
      if ($layout eq "table") { $rsshtml = asHTMLtable($rss,$rssuri); last CASE; };
      if ($layout eq "list") { $rsshtml = asHTMLlist($rss); last CASE; };
      # default to table
      $rsshtml = asHTMLtable($rss,$rssuri);
      last CASE;
    }
    my %s = ($tptag, $rsshtml);
    $output = sub_engine($template, \%s);
  } else { # RSS retrieve failed;
    $output = "<h1>RSS viewer ERROR</h1>\n<p>Unable to retrieve RSS at $rssuri<br />\nSorry</p>\n";
  }
} else { # no source RSS file
  $output = "<h1>RSS viewer ERROR</h1>\n<p>No RSS URL specified - please use add rss=url option<br />\nSorry</p>\n";
}

CASE: {
  if ($format eq "javascript") { 
	$output = asJavaScript($output); 
	last CASE; 
  }
  if ($format eq "html") { $output = $output; last CASE; };
 # defaults to JavaScript
  $output = asJavaScript($output);
  last CASE;
}

print $cgi->header();
print $output;

# == the end ==

sub readURL {
  my ($url) = @_;
  $url =  uri_unescape($url);
  print "$url\n";
  my $ua = LWP::UserAgent->new;
  #$ua->proxy(['http', 'ftp'], "http://scoop.ukoln.ac.uk:3128");
  $ua->agent('RDN RSS Viewer/1.1');
#  my $h = new HTTP::Headers
#          Cache-control => 'no-cache',
#          Pragma => 'no-cache';

  my $req = HTTP::Request->new(GET => "$url");#, $h;
  my $c = $ua->request($req);
#  my $content = $c->content;
#  $content =~ s/(\<[^\>]*\>)//;
#  print $content;
#  print scalar $c->content."\n";
  return $c->content;
#  return $content;
}

sub asHTMLlist {
  my ($raw) = @_;

  my $rss = new XML::RSS;
  my $toGo = "";
  eval { $rss->parse($raw); };
  if ($@) {
    $toGo .= "<h1>RSS viewer ERROR</h1>\nInvalid0 RSS<br />\nSorry<br />\n<!--asHTMLlist-->";
    return $toGo;
  }

  $toGo .= "<table width=\"95\%\"><tr>\n";
  $toGo .= "<td align=\"left\" valign=\"top\"><h3>".toLatin1($rss->{channel}{title})."</h3></td>\n";
  if ( $rss->{image}{url} ) {
	  $toGo .= "<td align=\"right\" valign=\"top\"><a href=\"".toLatin1($rss->{image}{link})."\"><img src=\"".toLatin1($rss->{image}{url})."\" alt=\"".toLatin1($rss->{image}{title})."\" border=\"0\" valign=\"top\" align=\"right\"></a></td>\n";
  } else {
	  $toGo .= "<td align=\"right\" valign=\"top\">&nbsp;</td>\n";
  }
  $toGo .= "</tr><tr>\n";
  $toGo .= "<td colspan=\"2\"><p>".toLatin1($rss->{channel}{description})." &lt;<a href=\"".toLatin1($rss->{channel}{link})."\">".toLatin1($rss->{channel}{link})."</a>&gt;</p></td>\n";
  $toGo .= "</tr></table>\n";
  $toGo .= "<form class=\"small\" action=\"".toLatin1($rss->{textinput}{link})."\">".toLatin1($rss->{textinput}{description})."<br><input name=\"".toLatin1($rss->{textinput}{name})."\"><br><input type=\"submit\" value=\"".toLatin1($rss->{textinput}{title})."\"></form>\n" if ($rss->{textinput}{title});
  $toGo .= "<ul>\n";
  for my $item (@{$rss->{items}}) {
    $toGo .= "<li><a href=\"".toLatin1($item->{'link'})."\">".toLatin1($item->{title})."</a> <br>\n";
    my $description = toLatin1($item->{description});
    $description =~ s/\[Programme details:\s*(.*)\]\s*//i;
    my $progDetails = $1;
    undef $1;
    $toGo .= "$description <br />\n";
    $toGo .= "<span class=\"article\" align=\"right\">[<a href=\"".$progDetails."\">Programme details</a>]</span>\n" if $progDetails;
  }
  $toGo .= "</ul><p calls=\"footer\">\n";
  $toGo .= "Contact: ".toLatin1($rss->{channel}{webMaster})."<br />" if ($rss->{channel}{webMaster});
  $toGo .= "Last modified: ".toLatin1($rss->{channel}{lastBuildDate})."<br />" if ($rss->{channel}{lastBuildDate});
  $toGo .= toLatin1($rss->{channel}{copyright})."<br />" if ($rss->{channel}{copyright});

  return $toGo;
}


sub asHTMLtable {
  my ($raw,$rssuri) = @_;
  my $toGo;
###
#	$toGo = "<pre>$raw</pre>\n";
#	return $toGo;
###

   if ( $raw =~ m|<feed[^>]+xmlns="http://|s ) {
	  # It's an Atom feed
	my $atom_feed;
	eval { $atom_feed = XML::Atom::Feed->new( $rssuri ); };
	if ($@) {
		$toGo .= "<h1>RSS viewer ERROR</h1>\n";
		$toGo .= "<p>Invalid Atom feed ($@)<br />\n";
		$toGo .= "Sorry</p>\n";
		return $toGo;
	}
	  $toGo .= "<div class=\"rssxpresschannel\" align=\"center\">\n";
	  $toGo .= "<table cellpadding=\"2\" width=\"80%\" class=\"rssxpresstable\">\n";
	  $toGo .= "<tr><th align=\"left\" valign=\"top\" class=\"rssxpresschtitle\" width=\"50%\">".$atom_feed->title()."</th>";
	  my $image = $atom_feed->logo() || $atom_feed->icon();
	  if ( $image)  {
		  $toGo .= "<td width=\"50\%\"><img border=\"0\" align=\"right\" valign=\"top\" src=\"$image\"></td>";
	  } else {
		  $toGo .= "<td width=\"50\%\">&nbsp;</td>";
	  }
	  $toGo .= "</tr>\n";  
	  if ( $atom_feed->subtitle() ) {
		  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpresschdesc\">".$atom_feed->subtitle()."</td></tr>\n";
	  }	
	  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressdivider\" bgcolor=\"#bbbbbb\"></td></tr>\n";
	  for my $entry ( $atom_feed->entries() ) {
		  my $link = $entry->link();
		$toGo .= "<tr><td colspan=\"2\" class=\"rssxpressittitle\" bgcolor=\"#dddddd\"><a href=\"".$link->href()."\">".$entry->title()."</td></tr>\n";
		my $description;
		if ( $entry->summary() ) {
			$description = $entry->summary();
		} elsif ( $entry->content() ) {
			$description = $entry->content();
			$description = $description->body() if $description->body();
		}
		$toGo .= "<tr><td colspan=\"2\" class=\"rssxpressitdesc\" bgcolor=\"#eeeeee\">".$description."</td></tr>\n";
	  }
	  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressdivider\" bgcolor=\"#bbbbbb\"></td></tr>\n";
	  $toGo .= "</table>\n";
	  $toGo .= "</div>\n";	
	  return $toGo;
  }
  
  # Else it's not Atom, try RSS
  my $rss = new XML::RSS;
  
  eval { $rss->parse($raw); };
	if ($@) {
		$toGo .= "<h1>RSS viewer ERROR</h1>\n";
		$toGo .= "<p>Invalid RSS<br />\n";
		$toGo .= "Sorry</p>\n";
		return $toGo;
	}

  # This is RSS 0.9 - 1.0
  $toGo .= "<div class=\"rssxpresschannel\" align=\"center\">\n";
  $toGo .= "<table cellpadding=\"2\" width=\"80%\" class=\"rssxpresstable\">\n";
  $toGo .= "<tr><th align=\"left\" valign=\"top\" class=\"rssxpresschtitle\" width=\"50%\">".toLatin1($rss->channel('title'))."</th>";
  if ( $rss->{image}{url} ) {
	  $toGo .= "<td width=\"50\%\"><a href=\"".toLatin1($rss->image('link'))."\"><img border=\"0\" align=\"right\" valign=\"top\" src=\"".toLatin1($rss->image('url'))."\"></a></td>";
  } else {
	  $toGo .= "<td width=\"50\%\">&nbsp;</td>";
  }
  $toGo .= "</tr>\n";  
  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpresschdesc\">".toLatin1($rss->channel('description'))."</td></tr>\n";
  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressdivider\" bgcolor=\"#bbbbbb\"></td></tr>\n";
  for my $item (@{$rss->{items}}) {
    $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressittitle\" bgcolor=\"#dddddd\"><a href=\"".toLatin1($item->{link})."\">".toLatin1($item->{title})."</td></tr>\n";
    $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressitdesc\" bgcolor=\"#eeeeee\">".toLatin1($item->{description})."</td></tr>\n";
  }
  $toGo .= "<tr><td colspan=\"2\" class=\"rssxpressdivider\" bgcolor=\"#bbbbbb\"></td></tr>\n";
  $toGo .= "</table>\n";
  $toGo .= "</div>\n";
  return $toGo;
}

sub asJavaScript {
  my ($content) = @_;
#  my $toGo = "<html><head></head><body><script language=\"text/javascript\"><!--\n";
  my $toGo = "";
  # output in specified format

#$content =~ s/&#10;//gi;
#$content =~ s/&#xD;//gi;
  foreach $line (split('\n', $content)) {
    $line =~ s///g;
    $line =~ s/"/'/gi;
    $line = toLatin1($line);
	$line =~ s/&#10;//gi;
	$line =~ s/&#xD;//gi;
	$line =~ s/\r/ /g;
	$line =~ s/\n/ /g;
    $toGo .= "document.write(\"$line\"); ";
}
#  $toGo .= "-->\n</script></body></html>\n";
   return $toGo;
}

sub sub_engine {
  my ($html, $subs) = @_;
  %subh = %{$subs};
  foreach $key (keys(%subh)) {
    $html =~ s/$key/$subh{$key}/g;
  }
  return $html;
}

sub toLatin1 {
  my ($in) = @_;
  decode_entities($in);                 # added by Paul Smith 2008-07-25 to address entity encoding issues
  encode_entities($in, "\200-\377");    # added by Paul Smith 2008-07-25 to address entity encoding issues
  my $u = utf8($in);
  return $u->latin1;
}