Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Displaying TV Listings (and no screen-scraping )

by spatterson (Pilgrim)
on Sep 22, 2005 at 13:51 UTC ( [id://494115]=CUFP: print w/replies, xml ) Need Help??

Inspired by some of the appalling TV listings websites, I decided I'd roll my own page with this script. It takes an XMLTV format input file (which can contain multiple channels) and generates a webpage with the times approximately aligned and the descriptions on mouseover. I have a seperate script which downloads the xml data from http://www.bleb.org/tv/data/listings/ you can see an example of the output at http://patter.mine.nu/~steve/newTV/ but please be gentle, I don't have much bandwidth.
#!/usr/bin/perl use strict; use XML::Simple; use Data::Dumper; use CGI qw/:all/; print header('text/html'); print <<__STYLE__ <style type="text/css"> td { vertical-align: top; } </style> __STYLE__ ; my $tv = XMLin('raw.xml'); # channel names & global channel info - array of hashes # can xref with programs by key: blebid my $chan_names = $tv->{xmltvid}; # generate cross-referencing hash my $chan_names = $tv->{xmltvid}; # generate cross-referencing hash my %xmltvid; foreach my $chan (@$chan_names) { $xmltvid{$chan->{content}} = $chan->{blebid}; } # programs on BBC 1 - ref to array of hashes [example] # my $channel = $tv->{channel}->{$xmltvid{'BBC 1'}}->{programme}; # &all_shows($channel, 'BBC 1'); print "<table border>\n"; &all_shows(); print "</table>\n"; sub all_shows { # my ($chanref, $channame) = @_; print "<tr>\n"; foreach my $chan (keys %xmltvid) { print " <th>$chan</th>\n"; } foreach my $hour (0 .. 23) { print "</tr>\n<tr>\n"; &this_hour($tv, $hour); print "</tr>\n<tr>\n"; &this_hour($tv, $hour); print "</tr><tr>\n"; } } sub this_hour { my ($tvref, $hour) = @_; # print '<pre>', Dumper $tvref, '</pre>'; foreach my $chan (keys %xmltvid) { # my $chan = 'BBC 1'; my $chanref = $tvref->{channel}->{$xmltvid{$chan}}->{programm +e}; print " <td>"; # print "<pre>", Dumper $chanref, "</pre>\n"; my $i = 0; foreach my $prog (@$chanref) { if (substr($prog->{start}, 0, 2) == $hour) { print '<table><tr><td>', $prog->{start}, '-', $prog->{end}, '</td>', "<td><div title='$prog->{subtitle} $prog->{desc}'>$pro +g->{title}", "</div></td></tr></table>"; } } } }
The other script which fetches the XMLTV data is a crufty little shell script which could probably be perlified with LWP::Simple and Archive::Zip, but its simpler this way :)
#!/bin/sh wget 'http://www.bleb.org/tv/data/listings?format=XMLTV&file=zip&chann +els=bbc1,bbc2,bbc3,bbc4,bbc7,itv1,ch4,five,abc1,bbc_6music,bbc_radio2 +,bbc_radio4,e4,itv2,itv3,uk_history&days=0' -O ~/public_html/newTV/bl +eb.zip --quiet unzip -qq -o -d ~/public_html/newTV ~/public_html/newTV/bleb.zip
just another cpan module author

Edit: g0n - linkified http links

Replies are listed 'Best First'.
Re: Displaying TV Listings (and no screen-scraping )
by castaway (Parson) on Sep 23, 2005 at 11:30 UTC
    Nice.. though I prefer the times-across-the-top, channels-down-the-side version that theorbtwo went for..

    You also might want to mention that these are UK TV listings, too ;)

    C.

      I just prefer this kinds of layout, though I'm going to refine the display a bit later.

      This one just displays UK programs because I've given it a UK-based XMLTV file, if you feed in a US based (or any other) XMLTV file, it'll just recognise the channels & programs in the xml file, and yes the channel columns are semi-randomly sorted (output by running keys on a hash).

      just another cpan module author
Re: Displaying TV Listings (and no screen-scraping )
by spatterson (Pilgrim) on Sep 27, 2005 at 10:57 UTC
    A perlish version of the script (hopefully), also untested and may overwrite things.
    use LWP::Simple; use Archive::Zip; my $url = 'http://www.bleb.org/tv/data/listings?format=XMLTV&file=zip& +channels=bbc1,bbc2,bbc3,bbc4,bbc7,itv1,ch4,five,abc1,bbc_6music,bbc_r +adio2,bbc_radio4,e4,itv2,itv3,uk_history&days=0'; my $zipfile = 'bleb.zip' if (is_success ( getstore $url, $zipfile ) { my $zip = Archive::Zip->new($zipfile); foreach my $z ($zip->members) { $zip->extractMember; } }
    just another cpan module author

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://494115]
Approved by kutsu
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2024-03-19 05:23 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found