root/grabbers/oztivo @ 479

#!/usr/bin/perl -w

# OzTivo grabber

my $version = '0.13';

# Requires configuration!
# 1. Register at http://www.tvguide.org.au/
# 2. Run "./oztivo --configure" to create "oztivo.pw" file.
#
# Changelog:
# 0.1   : Yucky little initial version
# 0.2   : --ready option
# 0.3.  : Don't log password
# 0.4   : Changed password filename
# 0.5   : Identify user agent; support gzip compression; turn off 
#         output buffering
# 0.6   : Decodes HTML characters
# 0.6.1 : Bugfix: Don't decode HTML characters (invalid XMLTV),
#         Bugfix: translate SBS NEWS XMLTVID properly
# 0.7   : Decodes apostrophes
# 0.9   : --configure
# 0.10  : Minor internal changes to be more forkable
# 0.11  : Exit on empty config file
# 0.12  : oztivo has invalid XMLTV (fields in wrong order, empty fields etc)
#         postprocess these
# 0.13  : all oztivo programming is in GMT.  add +0000 to its timezone
#         so the rest of shepherd knows this.

use strict;

use LWP::UserAgent;
use Cwd;
use Getopt::Long;
use HTML::Entities;

my $progname = 'oztivo';
my $nicename = 'OzTivo';
my $config_file = cwd() . "/$progname.pw";
my $output_file = cwd() . "/output.xmltv";
my $channels_file;
my $channels, my $opt_channels;
my @clist;
my $ver;
my $ready;
my $configure;
my $raw_input;
my $raw_output;

print "$nicename Grabber v$version\n";

$| = 1;

GetOptions( 
            'channels_file=s'   => \$channels_file,
            'output=s'          => \$output_file,
            'rawoutput=s'       => \$raw_output,
            'rawinput=s'        => \$raw_input,
            'version'           => \$ver,
            'ready'             => \$ready,
            'configure'         => \$configure
          );

exit 0 if ($ver);

configure() if ($configure);

unless (-r $config_file)
{
    die "Can't find $config_file!\nTry running with the --configure option.\n";
}

print "Reading configuration file $config_file.\n";

open(CONF, $config_file)
    or die "Unable to read config file $config_file: $!";
my $line = <CONF>;
close CONF;

unless ($line =~ /^(.*):(.*)$/)
{
    die "Unable to parse config file!\n" .
        "Should be in format: username:password\n";
}
my ($user, $pw) = ($1, $2);

unless ($user and $pw)
{
    die "Failed to extract a sensible username and password from config file!\n";
}

exit 0 if ($ready);

unless ($channels_file)
{
    die "No --channels_file specified.\n";
}

unless( -r $channels_file)
{
    die "Unable to read channels file $channels_file: $!";
}
local (@ARGV, $/) = ($channels_file);
eval <>;
die "\nError in channels file!\nDetails:\n$@" if ($@);

# Create a list of channel names from longest to shortest
@clist = sort { length $b <=> length $a } keys %$channels;
print "Channels: @clist.\n";

my $ua = LWP::UserAgent->new();
$ua->agent("Shepherd $nicename Grabber/$version");
$ua->default_header('Accept-Encoding' => 'gzip');

my $fn = "http://$user:YOURPASSWORD\@minnie.tuhs.org/tivo-bin/xmlguide.pl";
print "Retrieving $fn...\n";

$fn =~ s/YOURPASSWORD/$pw/;

my $data;

if (!defined $raw_input) {
    my $response = $ua->get($fn);
    unless ($response->is_success()) {
        print "Download failed.\n" . $response->status_line() . "\nExiting.\n";
        exit;
    }
    $data = $response->content();
    print "Downloaded " . int((do {use bytes; length($data)}) / 1024) . "KB.\n";

    if ($response->header('Content-Encoding')
        and
        $response->header('Content-Encoding') eq 'gzip') {
        print "Unzipping.\n";
        $data = Compress::Zlib::memGunzip($data);
    }

    if (defined $raw_output) {
        open(F,">$raw_output") || die "could not write raw output to $raw_output: $!\n";
        print F $data;
        close(F);
        print "Raw output saved in $raw_output.\n";
    }
} else {
    open(F,"<$raw_input") || die "could not read raw input from $raw_input: $!\n";
    while(<F>) {
        $data .= $_;
    }
    close(F);
    print "Raw input read from $raw_input.\n";
}

# print "Decoding HTML.\n";
# HTML::Entities::decode($data);

print "Converting apostrophes.\n";
$data =~ s/\&#39;/'/g;

print "Transforming XMLTVIDs.\n";
$data =~ s/channel="(.*)"/'channel="'.subme($1).'"'/ge;

print "Writing output.\n";
open (OUT, ">$output_file") || die "could not write to $output_file: $!\n";

#
# oztivo generates invalid XMLTV with fields out of order and
# some blank fields.
# the standard XMLTV.pm perl module gets very unhappy about these
# write output in a manner which addresses the bad input
#

my @xmltv_tag_order = qw [ title sub-title desc credits date category language
        orig-language length icon url country episode-num video audio
        previously-shown permiere last-chance new subtitles rating
        star-rating ];
my %xmltv_tags = map { $_ => "" } @xmltv_tag_order;
my $linenum = 0;
my $cur_field = "";

foreach my $line (split/\n/,$data) {
    $linenum++;

    # oztivo generates blank data for these fields - skip if blank
    next if ($line =~ /<director><\/director>/);
    next if ($line =~ /<desc><\/desc>/);

    if ($line =~ /\s*<([\/a-zA-Z\-]+)/) {
        my $field = lc($1);

        if (($field eq "programme") || ($field eq "/programme")) {
            # print all previously seen tags in xmltv_tag_order
            foreach my $xmltag (@xmltv_tag_order) {
                if ($xmltv_tags{$xmltag} ne "") {
                    print OUT $xmltv_tags{$xmltag};
                    $xmltv_tags{$xmltag} = "";
                }
            }

            # if we have a start="(time)" and/or stop="(time)" make sure they
            # have a timezone on them.
            $line = $1."start=\"".$2." +0000\"".$3 if ($line =~ /^(.*)start="([0-9]+)"(.*)/);
            $line = $1."stop=\"".$2." +0000\"".$3 if ($line =~ /^(.*)stop="([0-9]+)"(.*)/);

            print OUT $line."\n"; # programme tag
            $cur_field = "";
        } else {
            # do we know about this tag?
            $cur_field = $field if (defined $xmltv_tags{$field});

            if ($cur_field eq "") {
                print OUT $line."\n";
            } else {
                $xmltv_tags{$cur_field} .= $line."\n";
            }
        }
    } else {
        print OUT $line."\n";
    }
} 

close OUT;

print "Done.\n";

sub configure
{
    print "Configuring...\n\n" .
          "Before you can use the $nicename grabber, you must create an\n" .
          "account here:\n\n" .
          '  http://minnie.tuhs.org/twiki/bin/view/TWiki/TWikiRegistration' .
          "\n\n" .
          "When you're done, you'll have a username and a password. Enter\n" .
          "these here.\n\n" .
          "Username? ";
    my $username = <>;
    chomp $username;
    print "Password? ";
    my $pw = <>;
    chomp $pw;

    print "Creating config file $config_file...\n";
    open (CONF, ">$config_file")
        or die "Unable to create $config_file: $!";
    print CONF "$username:$pw";
    close CONF;

    print "Done.\n";
    exit 0;
}

sub subme
{
    my $station = shift;

    $station = "SBS NEWS" if ($station eq "SBS-NEWS");

    foreach (@clist)
    {
        return $channels->{$_} if ($station =~ /$_/i);
    }
    print "Warning: station \"$station\" unknown.\n";
    return $station;
}