#! /usr/bin/perl
### -------------------------------------------------------------------------
### Program: bbc_l3.pl:
### Copyright (c) 2006 Robin Gilks
###
### 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.
###
### You should have received a copy of the GNU General Public License
### along with this program; if not, write to the Free Software
### Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
### -------------------------------------------------------------------------
###
### This is a MythStream parser or harvester
### The idea is to get the RealPlayer historic content from the various
### radio stations that the BBC runs. Most programs are available for streaming
### for up to 7 days after broadcast.
###
### Radio 4 has changed its player web page so we have to change stuff
###    MythStream passes in the URL which is specified in streams.res
###    or the database so we get eg 
###  streams.res = /radio4/progs/listenagain.shtml
###  get http://www.bbc.co.uk/radio4/progs/listenagain.shtml
###    we parse out the lines with 'aodpopup' in them having remembered the text 
###    in any previous <span> or <br> to get the program name eg.
### <img src="/furniture/tiny.gif" width="1" height="5" border="0" alt="" /><br />The Archers<br />
### <a class="la1" href="/radio/aod/radio4_aod.shtml?radio4/archers" onclick="aodpopup('/radio/aod/radio4_aod.shtml?radio4/archers');" target="aod">
###
### <img src="/furniture/tiny.gif" width="1" height="5" border="0" alt="" /><br />The Party Line<br />
### <a class="la1" href="/radio/aod/radio4_aod.shtml?radio4/party_line" onclick="aodpopup('/radio/aod/radio4_aod.shtml?radio4/party_line');" target="aod">
###
###    *** So far, no description to be extracted from the data ***
### 
###    We then pass back with a handler=level4 and display the list we have eg.
###  <item>
###      <name>The Archers</name>
###      <url>/radio/aod/radio4_aod.shtml?radio4/archers</url>
###      <handler>bbc_l4</handler>
###  </item>
###    Some items are available without further parsing - they have '.ram' as part 
###    of the url. No handler is returned for these so they get played immediately.
### <img src="/furniture/tiny.gif" width="1" height="5" border="0" alt="" /><br />Think About It<br />
### <a class="la1" href="/radio4/science/rams/thinkaboutit.ram">Listen<img src="/radio4/images/lalisten.gif" width="14" height="8" border="0" alt="Listen" /></a>
###  <item>
###      <name>Think About It</name>
###      <url>/radio4/science/rams/thinkaboutit.ram</url>
###  </item>
###
###    When the user selects a show we grab the next page using bbc_l4.pl and parse 
###    out the lines with 'bbcplayer' in them (a bit like bbc_l1 does) eg.
### <frame name="bbcplayer" title="Audio controls and information." src="/radio/aod/networks/radio4/aod.shtml?radio4/archers" marginwidth="0" marginheight="0" scrolling="auto" frameborder="0" />
###    We then pass that url to the next handler which is the original level 2.
###  <item>
###      <name>Dummy</name>
###      <url>/radio/aod/networks/radio4/aod.shtml?radio4/archers</url>
###      <handler>bbc_l2</handler>
###  </item>
###  See bbc_l1.pl for documentation on what happens next in bbc_l2.pl!!
### -------------------------------------------------------------------------

use English;
use XML::DOM;
use HTML::TokeParser;

#------------------------------------------------------------------------------
# Init
#------------------------------------------------------------------------------

&read_parse();    # get commandline parameters into @in
$source = $in[0]; # source filename from command line

my $doc = XML::DOM::Document->new;
my $head = $doc->createXMLDecl ('1.0');
my $root = $doc->createElement('items');

sub newNode
{
  local $name  = shift;
  local $value = shift;
  local $node = $doc->createElement($name);
  local $text = $doc->createTextNode($value);
  $node->appendChild($text);
  
  return $node;
}

#------------------------------------------------------------------------------
# read file into $data
#------------------------------------------------------------------------------

$datafile = $source;
open( INFO, "<$datafile" );      # Open file for reading
undef $/;
$data = <INFO>;                 # Read all
close(INFO) ;

#------------------------------------------------------------------------------
# search url's in $data and create XML
#------------------------------------------------------------------------------


my $p = HTML::TokeParser->new(\$data);
my $s_description = "";

while (my $token = $p->get_tag("a")) {
   my $url = $token->[1]{href};
   my $dummy = $p->get_trimmed_text("/a");
   my $onclick = $token->[1]{onclick}; 
   my $description = $p->get_trimmed_text("a", "/li", "/div", "/span");
   $name = $s_description;
   $s_description = $description;
   if (($onclick =~ /aodpopup/ ) && (length ($name) > 1)) {
      $item = $doc->createElement('item');
      $root->appendChild($item);
      $item->appendChild( newNode('name', $name) );
      $item->appendChild( newNode('url', $url ) );
      $item->appendChild( newNode('handler', "bbc_l4") );
   }
   if (($url =~ /.ram/ )&& (length ($name) > 1)){
      $item = $doc->createElement('item');
      $root->appendChild($item);
      $item->appendChild( newNode('name', $name) );
      $item->appendChild( newNode('url', $url ) );
      # note - no handler. Process it directly
   }
}

print $head->toString;
print $root->toString;
print "\n";

#--------------------------------------------------------------------------------
# get command line parameters
#--------------------------------------------------------------------------------

sub read_parse 
{
  local (*in) = @_ if @_;
  local ($i);
  push(@in, @ARGV);
  foreach $i (0 .. $#in) { $in[$i] =~ s/\+/ /g;}
  return scalar(@in);
}


