#!/usr/bin/perl

use CGI qw(:all);
use LWP::UserAgent;
########## Installation Instructions ##############
#
# Install the program in a directory where You are
# allowed to execute cgi scripts.
# Set permissions to executable.
# Call the script with SSI.
#
############# Configuration Area ##################
#
# Seconds to wait for reply from Coti Website.
$timeout = 5;
#
# What feed to use
# 6  = Lone star chatter
# 12 = T20 Transmissions
# 14 = T5 Transmissions
# 16 = TNE Transmissions
# 18 = COTI - Today's Active Topics
# 20 = FLEET DISPATCHES
$xmlno = 20;
#
# RGB colors used in table
$tabcol[0] = "#FFFFFF"; 
$tabcol[1] = "#EEEEEE";
#
# Path for cache and lockfile (writable by webserver)
$cache = "coti/cotitemp.txt";
$dummylock = "coti/cotidummylock.txt";
#
# If Cache older than this it is updated. (Days)
$cachelife = 0.021; # ~30min 
#
###################################################
# You really don't have to modify anything below this line

print header;

# Calculate URL depending on input
$url = "http://www.TravellerRPG.com/CotI/Discuss/ContentIslands/$xmlno/rss092.xml";

# Determine age of cache
$age = (-M $cache);

# Get a lock on the cache, so that it cannot get overwritten by mistake.
&get_lock();

# Check if we need to update cache
if (($age > $cachelife) or ((-s $cache) == 0))
 {
  $feed = &get_url($url,$timeout);   
  if ($feed ne "") 
   { 
    &write_file($feed,$cache);
   }
 } 

# Get data from cache
@lines = &get_cache($cache);

# Release the lock
&lose_lock();

$item = 0;

foreach $line (@lines)
  {
# item
   if ($line =~ m,<item>,)
   {
    $item++;
   }
# title
   if ($line =~ m,<title>(.*)</title>,)
   { 
    $title[$item] = $1;
   }
# link
   if ($line =~ m,<link>(.*)</link>,)
   { 
    $link[$item] = $1;
   }
  } # end foreach

print "<table border=0 cellpadding=2>";

for ($post = 0; $post <= $item; $post++)
 {
  $tcol = $post%2;
  print "<tr>\n<td bgcolor=\"", $tabcol[$tcol],"\"><a href=\"$link[$post]\">$title[$post]</a></td></tr>\n";
 }
 print "</table>";

THEEND:
exit;

############ End of Program ##############
 
# Subroutines

sub get_lock
 {
  open(DUMMY, ">$dummylock");
  flock(DUMMY, 2);
 }

sub lose_lock
 {
  flock(DUMMY, 8);
  close(DUMMY);
 }

sub get_cache
{
  my ($cache) = @_;
  my @news = "";
  open(CACHE, $cache);
  @news = <CACHE>;
  close(CACHE);
  return @news;
}

sub get_url
{
  my ($url,$timeout_length) = @_;
  my $page_returned = "";
  $ua = new LWP::UserAgent;
  $ua->timeout($timeout_length);
  my $req = new HTTP::Request GET => "$url";
  my $res = $ua->request($req);
  if ($res->is_success) { $page_returned = $res->content; } 
  return $page_returned;
}

sub write_file
{
  my ($outputstring,$filename) = @_;
  open(PAGE,">$filename");
  print PAGE $outputstring;
  close (PAGE);
}