Hi Rob,
Here is a foxtel grabber from Mark. He sent it to me awhile ago because
he isn't on the myth-user mail list.
Paul
-----Forwarded Message-----
> From: Mark Spieth <[EMAIL PROTECTED]>
> To: [EMAIL PROTECTED]
> Subject: update to ninemsn grabber
> Date: Wed, 01 Dec 2004 14:49:31 +1100
>
> also a foxtel with conf one that grabs from www.foxtel.tv
> which works ok. can get listing a whole month ahead.
> conf is extension of d1 conf file to allow mapping of unknown d1
channels
> also since main and adult are same in analog, a special case for
> multichannels. takes about 20 min for a month of progs.
> post if you like. too many posts on users for me so only on dev. thus
I
> send it to you.
> may be able to parallelize gets too.
>
> I run them both after d1 fetch in cron so that if these fail at least
I
> have something.
>
> cheers
> mark
# tv_grab_au 0.6 config file
region Melbourne
service foxtel
# "channel name" and "frequency" can be changed to suit
# [+yes/-no] [channel ID] [channel name] [frequency]
+channel foxtel.australia.Animal "Animal Planet" 15
+channel foxtel.australia.Antenna "Antenna Pacific" 52
+channel foxtel.australia.Arena "Arena TV" 22
+channel foxtel.australia.BBC "BBC World" 37
+channel foxtel.australia.Bloomber "Bloomberg TV" "Bloomberg Television"
+channel foxtel.australia.Cartoon "Cartoon Network" 28
+channel foxtel.australia.CNBC "CNBC Australia" 38
+channel foxtel.australia.CNN "CNN" 36
+channel foxtel.australia.Com "The Comedy Channel" 25
+channel foxtel.australia.Disc "Discovery Channel" 19
+channel foxtel.australia.Disney "Disney Channel" 27
+channel foxtel.australia.EPG "Program Guide" 13
+channel foxtel.australia.ESPN "ESPN" 16
+channel foxtel.australia.FFC "FOX Footy Channel" 14
+channel foxtel.australia.FOX "FOX8" 8
+channel foxtel.australia.FoxCLA "FOX Classics" 6
+channel foxtel.australia.FoxFNC "FOX News" 35
+channel foxtel.australia.FoxFS1 "FOX Sports" 11
+channel foxtel.australia.FoxHST "The History Channel" 17
+channel foxtel.australia.FoxMAE "Main Event/Adult/FTV" "Adults Only"
+channel foxtel.australia.FoxMAE "Main Event/Adult/FTV" "Main Event"
+channel foxtel.australia.FoxMMX "musicMAX" "MAX"
+channel foxtel.australia.FoxSH2 "Showtime 2" 33
+channel foxtel.australia.FoxSP2 "FOX Sports 2" 12
+channel foxtel.australia.Hall "Hallmark" 24
+channel foxtel.australia.Lifes "Lifestyle Channel" "The LifeStyle Channel"
+channel foxtel.australia.Movie1 "Movie One" 29
+channel foxtel.australia.MovieEx "Movie Extra" 30
+channel foxtel.australia.MovieGr "Movie Greats" 31
+channel foxtel.australia.MTV "MTV" 45
+channel foxtel.australia.NatGe "National Geographic" "National Geographic
Channel"
+channel foxtel.australia.Nick "Nickelodeon" 5
+channel foxtel.australia.Ovation "Ovation" 26
+channel foxtel.australia.RAI "RAI International" 51
+channel foxtel.australia.Red "Channel [V]" 43
+channel foxtel.australia.Show "Showtime" 3
+channel foxtel.australia.ShowGreats "Showtime Greats" 4
+channel foxtel.australia.SkyNews "Sky News" "Sky News Australia"
+channel foxtel.australia.SkyRa "Sky Racing" 50
+channel foxtel.australia.TCM "TCM" 32
+channel foxtel.australia.TV1 "TV1" 1
+channel foxtel.australia.TVSN "TVSN" 49
+channel foxtel.australia.UKTV "UKTV" 20
+channel foxtel.australia.W "W" 23
+channel foxtel.australia.Weather "The Weather Channel" 40
+channel foxtel.australia.wmov "World Movies" 42
+channel foxtel.Melbourne.10 "Network TEN" 10
+channel foxtel.Melbourne.2 "ABC Victoria" 2
+channel foxtel.Melbourne.7 "Channel Seven" 7
+channel foxtel.Melbourne.9 "Channel Nine" 9
+channel foxtel.Melbourne.SBS "SBS" 41
#!/usr/bin/perl -w
eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
if 0; # not running under some shell
=head1 NAME
tv_grab_au (0.6) - Grab TV listings for Australia.
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 SEE ALSO
L<xmltv(5)>. L<http://www.onlinetractorparts.com.au/rohbags/>
=head1 AUTHOR
=head1 BUGS
=cut
# If it doesn't work with mythfilldatabase, try:
# mythfilldatabase --file 1 -1 /var/local/tv_grab_au/guide.xml
use Getopt::Long;
use XMLTV;
use LWP::Simple;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use HTML::TreeBuilder;
use Date::Manip;
use Time::Zone;
use File::Path;
use threads;
use Thread::Queue;
#use strict;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::Config_file;
use XMLTV::Get_nice;
use XMLTV::Usage <<END
$0 : grab foxtel television listings in XMLTV format
To configure: $0 --configure [--config-file FILE]
To grab listings: $0 [--config-file FILE] [--output FILE] [--days N]
[--quiet] [--debug]
To list channels: $0 --list-channels
END
;
# choose the XMLID URL suffix that mythtv knows
#
my $XMLTVID_URL = "d1.com.au";
# change to how you think it should work
my $days_to_grab = 7;
my $threads = 5;
my $retrys = 3;
my $secondsbeforeretry = 2;
# Variables
my $guide_url = "http://www.foxtel.tv/TVGuide.aspx";;
#my $details_url = "http://tvguide.ninemsn.com.au/closeup/default.asp?pid=";;
#my $cache_dir = "/var/local/tv_grab_au";
my $cache_dir = "tv_grab_au_cache";
my %channels;
my %channelname;
my @dates;
Date_Init("DateFormat=AUS");
sub getTimezoneOffset(%)
{
my $d = shift;
my $to = UnixDate($d,"%s");
my $to1 = tz_local_offset($to);
my $toh = $to1/3600;
my $tom = $to1/60 - $toh*60;
my $s = sprintf "+%d%02d",$toh,$tom;
return $s;
}
# Options
my $opt_days;
my $opt_output;
my $opt_configfile;
my $opt_configure = 0;
my $opt_listchannels = 0;
my $opt_location;
my $opt_cachedir;
my $opt_debug;
my $opt_quiet;
GetOptions('days=i' => \$opt_days,
'output=s' => \$opt_output,
'config-file=s' => \$opt_configfile,
'location=s' => \$opt_location,
'cache-dir=s' => \$opt_cachedir,
'help' => \$opt_help,
'debug' => \$opt_debug,
'quiet' => \$opt_quiet,
'configure' => \$opt_configure,
'list-channels' => \$opt_listchannels,
) or usage(0);
usage(1) if $opt_help;
# XMLTV config file.
my $config_file = XMLTV::Config_file::filename($opt_configfile, 'tv_grab_au', $opt_quiet);
#if ($opt_location) {
# B
# $location = $opt_location;
#}
if ($opt_cachedir) {
$cache_dir = $opt_cachedir;
}
if ($opt_days) {
$days_to_grab = $opt_days;
}
if (!($opt_output)) {
#$opt_output = $cache_dir . "/guide.xml";
}
# $opt_configfile should probably do something ('/home/mythtv/.mythtv/tv_grab_au.xmltv')
my $source = "Melbourne";
my $location = "foxtel";
my $XMLTV_prefix = $source . "." . $location . ".";
my $XMLTV_suffix = "." . $XMLTVID_URL;
if ($opt_configure == 1)
{
print STDERR "configuration must be done in this script $0\n";
exit (0);
}
#print STDERR "starting $threads threads\n";
#
#my @thrlist;
#my $datepids = Thread::Queue->new;
#
#for (my $thread=0; $thread<$threads; $thread++)
#{
# push @thrlist, threads->new(\&fetch_details);
#}
my $prog_ref;
my $chan_ref;
my ($region, $service, $ch_xid, $ch_wid, $ch_name, $ch_xmlid);
my (%yeschannels, %nochannels,
%channels_name, %channels_lookup,
%nochannels_name, %channels_freq);
my $ua = LWP::UserAgent->new;
$ua->timeout(20);
$ua->agent('tv_grab_au_foxtel ');
my $viewstate;
sub getConfig()
{
# Not configuring or listing, must be grabbing.
my $line_num = 0;
foreach (XMLTV::Config_file::read_lines($config_file))
{
++ $line_num;
next if not defined;
my $where = "$config_file:$line_num";
if (/^region:?\s+(\w+)$/){
warn "$where: already seen region\n" if defined $region;
$region = $1;
if ($opt_debug){print "* D1: region= $region\n";}
}
elsif (/^service:?\s+(\w+)$/){
warn "$where: already seen service\n" if defined $service;
$service = $1;
if ($opt_debug){print "* D1b: service= $service\n";}
}
elsif (/^\+channel:?\s(\S+)$/){$usechannels{$1}=$1;}
elsif (/^-channel:?\s(\S+)$/){$nochannels{$1}=$1;}
elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"\s\"(.*?)\"$/){
$usechannels{$1}=$1;
$channels_name{$1}=$2;
$channels_lookup{uc $3} = $1;
}
elsif (/^-channel:?\s(\S+)\s\"(.*?)\"\s\"(.*?)\"$/){$nochannels{$1}=$1; $nochannels_name{$1}=$2;}
elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"$/){$usechannels{$1}=$1; $channels_name{$1}=$2;}
elsif (/^-channel:?\s(\S+)\s\"(.*?)\"$/){$nochannels{$1}=$1; $nochannels_name{$1}=$2;}
elsif (/^\+channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$usechannels{$1}=$1;$channels_name{$1}=$2;$channels_freq{$1}=$3;}
elsif (/^-channel:?\s(\S+)\s\"(.*?)\"\s(\d+)$/){$nochannels{$1}=$1;$nochannels_name{$1}=$2;$channels_freq{$1}=$3;}
else {warn "$where: bad line\n";}
}
foreach $ch (sort keys(%usechannels))
{
# print "$channels_name{$ch}\n";
$channels_lookup{uc $channels_name{$ch}} = $ch;
}
}
sub getLists()
{
my $form = get_form($ua,1);
#print $form;
#man lwpcook
my $tree = HTML::TreeBuilder->new;
$tree->parse($form);
#$tree->dump;
my $f1 = $tree->look_down('_tag','form','name','Form1');
#print join '',$f1->content_list;
#$f1->dump;
my $datetree = $f1->look_down('_tag','select','name','ddlSearchDate');
#$datetree->dump;
#ddlDayPeriod value = 1 for all day
#ddlCategory 0 for all
#ddlChannel select
my $chantree = $f1->look_down('_tag','select','name','ddlChannel');
#$chantree->dump;
my @datea = $datetree->look_down('_tag','option');
my @chana = $chantree->look_down('_tag','option');
foreach $chan (@chana) {
#print $chan->attr_get_i('value'), ' ', $chan->as_text,"\n";
my $v = $chan->attr_get_i('value');
next if $v == 0;
$t = $chan->as_text;
$t =~ s/ *$//;
$channels{$t} = $v;
}
my $gottoday = 0;
foreach $idate (@datea) {
#print $chan->attr_get_i('value'), ' ', $chan->as_text,"\n";
#push $dates{$idate->as_text} = $idate->attr_get_i('value')
#print $idate->as_text,"\n";
if ($idate->as_text eq "Today") { $gottoday = 1; }
if ($gottoday == 1)
{
push @dates, $idate->attr_get_i('value');
}
}
my $vs = $f1->look_down('_tag','input','name','__VIEWSTATE');
$viewstate = $vs->attr_get_i('value');
#print $viewstate;
#do post set ddlChannel
$tree = $tree->delete;
}
sub checkChannels()
{
my $chname;
foreach $chname (sort keys(%channels))
{
if (exists($channels_lookup{uc $chname}))
{
if (exists($channels_name{$channels_lookup{uc $chname}}))
{
print STDERR "$channels_lookup{uc $chname} \"$chname\" d1's \"$channels_name{$channels_lookup{uc $chname}}\"\n";
}
else
{
print STDERR "*** $channels_lookup{uc $chname} \"$chname\"\n";
}
}
else
{
print STDERR "unassigned \"$chname\"\n";
}
}
#exit 0;
}
sub genChannels()
{
foreach $chname (sort keys(%channels))
{
if (exists($channels_lookup{uc $chname}))
{
my $name = $chname;
if (exists($channels_lookup{uc $chname}))
{
$name = $channels_name{$channels_lookup{uc $chname}};
}
$$chan_ref{$chname} =
{
'id' => $channels_lookup{uc $chname} . $XMLTV_suffix ,
'display-name' => [ [ $name, undef ] ]
}
#print "$channels_lookup{uc $chname} \"$chname\"\n";
}
}
}
#foreach $i (@dates) {
# print "$i\n";
#}
sub getProgramInfo($$)
{
my $channel = shift;
my $date = shift;
# convert it to be same as xmltvid
my @progs;
my $ua1 = $ua->clone;
my $resp = $ua1->post($guide_url,[
__VIEWSTATE => $viewstate,
ddlSearchDate => $date,
ddlDayPeriod => 1,
ddlCategory => 0,
ddlChannel => $channels{$channel},
txtKeyword => 'Enter+Keyword',
'ibtnGuideSearch.x' => 15,
'ibtnGuideSearch.y' => 11
]);
$channel = $channels_lookup{uc $channel} . $XMLTV_suffix;
#print $resp->content;
#{
# my $tree2 = HTML::TreeBuilder->new;
# $tree2->parse($resp->content);
# my $tab = $tree2->look_down('_tag','td','id','tblCellTVGuideResults');
# $tab->dump;
# $tree2 = $tree2->delete;
#}
#study $resp->content;
@m1 = $resp->content =~ /<span class="guidehead">(.*?) (.*?) ?<\/span><span class="guidetext">(.*?)<br \/> (.*?)\. (.*?)<\/span>/g;
#print join ':',@m1;
while ($#m1 >= 0)
{
my $time = shift @m1;
$time =~ s/\./:/;
$time = $time . ' ' . $date;
$time = ParseDate($time);
if ((UnixDate($time,"%H")+0)<6)
{
$time = &DateCalc($time, "+ 1 day");
}
my $offset = getTimezoneOffset($time);
$time = UnixDate($time,"%Y%m%d%H%M%S") . " " . $offset;
my $title = shift @m1;
my $subtitle = shift @m1;
my $genre = shift @m1;
my $descr = shift @m1;
my $rating;
$descr =~ /(.*?) +\((.*)\) ?/ && do {
$descr = $1;
$rating = $2;
};
#print "$time $title : $subtitle : $genre : $rating\n $descr\n";
my $a_prog = {
channel => $channel,
start => $time,
stop => $time, # temp
title => [ [ $title, undef ] ]
};
$descr =~ s/^\s+//;
$descr =~ s/\s+$//;
$genre =~ s/\s+$// if ($genre);
if ($subtitle) { $$a_prog{'sub-title'} = [ [ $subtitle, undef ] ]; }
if ($descr) { $$a_prog{desc} = [ [ $descr, undef ] ]; }
if ($genre) { $$a_prog{category} = [ [ $genre, undef ] ]; }
if ($rating) { $$a_prog{rating} = [ [ $rating, "CTVA", undef ] ]; }
if ($#progs >= 0)
{
if ($progs[$#progs]{channel} eq $channel)
{
$progs[$#progs]{stop} = $time;
}
}
push @progs, $a_prog;
}
return @progs;
}
sub get_form
{
my $ua = shift;
my $force = shift;
my $url = $guide_url;
my $guide_dir = $cache_dir;
my $guide_file = $guide_dir . "/guide.html";
mkpath ($guide_dir);
my $resp;
for (my $retry=0; ($retry<$retrys); $retry++)
{
$resp = $ua->get($guide_url);
last if $resp->is_success;
print ".";
sleep($secondsbeforeretry);
}
return $resp->content;
}
sub configure() {
my $freq = 0;
XMLTV::Config_file::check_no_overwrite($config_file);
open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
&getLists();
&getConfig();
print CONF "# tv_grab_au_foxtel config file\n"; #region $c\nservice $d\n";
print CONF "# \"channel name\" and \"frequency\" can be changed to suit\n";
print CONF "# [+yes/-no] [channel ID] [foxtel name] [channel name] [frequency]\n";
foreach $ch (keys(%channels))
{
my $ch2 = $ch;
$ch2 =~ s/ //g;
my $id = "foxtel.australia.$ch2";
print CONF "+channel $id \"$ch\" \"$ch\" $freq\n";
}
close CONF;
print "All done, run with no arguments to grab listings.\n";
}
##########################################################################
#
if ($opt_listchannels)
{
&getLists();
foreach $ch (keys(%channels))
{
print "$ch\n";
}
exit 0;
}
if ($opt_configure)
{
&configure();
exit 0;
}
print STDERR "grabing $days_to_grab days into ",($opt_output)?$opt_output:"stdout","\n";
&getLists();
&getConfig();
&checkChannels() if $opt_debug;
if ($#channels < 0)
{
print STDERR "Warning: no channels found!\n";
}
else
{
foreach $chan (sort keys(%channels))
{
next if !(exists($channels_lookup{uc $chan}));
print STDERR "chan is $chan $channels_lookup{uc $chan}\n";
my $day_counter = 0;
my $lastprogchan = $#$prog_ref;
my $lastprog;
while ($day_counter < $days_to_grab)
{
last if (!exists($dates[$day_counter]));
$lastprog = $#$prog_ref;
push @$prog_ref, getProgramInfo($chan,$dates[$day_counter]);
# fixup last time on previous list
if ($lastprog >= 0)
{
my $nextprog = $lastprog+1;
#print STDERR "$lastprog $nextprog $#$prog_ref\n";
if ($nextprog <= $#$prog_ref)
{
#print STDERR " ($$prog_ref[$nextprog]{channel} eq $$prog_ref[$lastprog]{channel})\n";
if ($$prog_ref[$nextprog]{channel} eq $$prog_ref[$lastprog]{channel})
{
$$prog_ref[$lastprog]{stop} = $$prog_ref[$nextprog]{start};
}
}
}
$day_counter++;
# $currentday = &DateCalc($currentday, "+ 1 day");
}
{
$lastprog = $#$prog_ref;
$$prog_ref[$lastprog]{start} =~ /(\S+) \S+/;
my $time = ParseDate($1);
#print STDERR "time $time\n";
$time = &DateCalc($time, "+ 1 hour");
#print STDERR "time $time\n";
my $offset = getTimezoneOffset($time);
$time = UnixDate($time,"%Y%m%d%H%M%S") . " " . $offset;
#print STDERR "time $time\n";
$$prog_ref[$lastprog]{stop} = $time;
}
if ($lastprogchan == $#$prog_ref)
{
print STDERR "Warning: no programs found for channel $chan\n";
}
}
&genChannels();
my $data = [
'ISO-8859-1',
{
'source-info-name' => 'http://www.foxtel.tv/',
'generator-info-name' => 'Foxtel grabber',
'generator-info-url' => '',
'generator-info-name' => "XMLTV - tv_grab_au Foxtel v0.2"
},
$chan_ref,
$prog_ref
];
print STDERR "writing file\n";
my $fh;
if ($opt_output)
{
$fh = new IO::File ">$opt_output";
}
else
{
$fh = \*STDOUT;
}
XMLTV::write_data($data, OUTPUT=>$fh);
}
print STDERR "done\n";
_______________________________________________
mythtv-users mailing list
[EMAIL PROTECTED]
http://mythtv.org/cgi-bin/mailman/listinfo/mythtv-users
