| 1 | #!/usr/bin/perl -w |
|---|
| 2 | |
|---|
| 3 | # OzTivo grabber |
|---|
| 4 | |
|---|
| 5 | my $version = '0.6'; |
|---|
| 6 | |
|---|
| 7 | # Requires configuration! |
|---|
| 8 | # 1. Register at http://www.tvguide.org.au/ |
|---|
| 9 | # 2. Create file "oztivo.conf" containing the line "username:password" |
|---|
| 10 | # (no quotation marks), e.g. tomdaniels:qwerty09 |
|---|
| 11 | # |
|---|
| 12 | # Changelog: |
|---|
| 13 | # 0.1 : Yucky little initial version |
|---|
| 14 | # 0.2 : --ready option |
|---|
| 15 | # 0.3. : Don't log password |
|---|
| 16 | # 0.4 : Changed password filename |
|---|
| 17 | # 0.5 : Identify user agent; support gzip compression; turn off |
|---|
| 18 | # output buffering |
|---|
| 19 | # 0.6 : Decodes HTML characters |
|---|
| 20 | |
|---|
| 21 | use strict; |
|---|
| 22 | |
|---|
| 23 | use LWP::UserAgent; |
|---|
| 24 | use Cwd; |
|---|
| 25 | use Getopt::Long; |
|---|
| 26 | use HTML::Entities; |
|---|
| 27 | |
|---|
| 28 | my $config_file = cwd() . "/oztivo.pw"; |
|---|
| 29 | my $output_file = cwd() . "/output.xmltv"; |
|---|
| 30 | my $channels_file; |
|---|
| 31 | my $channels; |
|---|
| 32 | my @clist; |
|---|
| 33 | my $ver; |
|---|
| 34 | my $ready; |
|---|
| 35 | my $desc; |
|---|
| 36 | |
|---|
| 37 | print "OzTivo Grabber v$version\n"; |
|---|
| 38 | |
|---|
| 39 | $| = 1; |
|---|
| 40 | |
|---|
| 41 | GetOptions( |
|---|
| 42 | 'channels_file=s' => \$channels_file, |
|---|
| 43 | 'output=s' => \$output_file, |
|---|
| 44 | 'version' => \$ver, |
|---|
| 45 | 'ready' => \$ready, |
|---|
| 46 | 'desc' => \$desc |
|---|
| 47 | ); |
|---|
| 48 | |
|---|
| 49 | exit 0 if ($ver); |
|---|
| 50 | |
|---|
| 51 | print "Reading configuration file $config_file.\n"; |
|---|
| 52 | |
|---|
| 53 | open(CONF, $config_file) |
|---|
| 54 | or die "Unable to read config file $config_file: $!"; |
|---|
| 55 | my $line = <CONF>; |
|---|
| 56 | close CONF; |
|---|
| 57 | |
|---|
| 58 | unless ($line =~ /^(.*):(.*)$/) |
|---|
| 59 | { |
|---|
| 60 | die "Unable to parse config file!\n" . |
|---|
| 61 | "Should be in format: username:password\n"; |
|---|
| 62 | } |
|---|
| 63 | my ($user, $pw) = ($1, $2); |
|---|
| 64 | |
|---|
| 65 | exit 0 if ($ready); |
|---|
| 66 | |
|---|
| 67 | unless ($channels_file) |
|---|
| 68 | { |
|---|
| 69 | die "No --channels_file specified.\n"; |
|---|
| 70 | } |
|---|
| 71 | |
|---|
| 72 | unless( -r $channels_file) |
|---|
| 73 | { |
|---|
| 74 | die "Unable to read channels file $channels_file: $!"; |
|---|
| 75 | } |
|---|
| 76 | local (@ARGV, $/) = ($channels_file); |
|---|
| 77 | eval <>; |
|---|
| 78 | die "\nError in channels file!\nDetails:\n$@" if ($@); |
|---|
| 79 | |
|---|
| 80 | # Create a list of channel names from longest to shortest |
|---|
| 81 | @clist = sort { length $b <=> length $a } keys %$channels; |
|---|
| 82 | print "Channels: @clist.\n"; |
|---|
| 83 | |
|---|
| 84 | my $ua = LWP::UserAgent->new(); |
|---|
| 85 | $ua->agent("Shepherd OzTivo Grabber/$version"); |
|---|
| 86 | $ua->default_header('Accept-Encoding' => 'gzip'); |
|---|
| 87 | |
|---|
| 88 | my $fn = "http://$user:YOURPASSWORD\@minnie.tuhs.org/tivo-bin/xmlguide.pl"; |
|---|
| 89 | print "Retrieving $fn...\n"; |
|---|
| 90 | |
|---|
| 91 | $fn =~ s/YOURPASSWORD/$pw/; |
|---|
| 92 | |
|---|
| 93 | my $response = $ua->get($fn); |
|---|
| 94 | unless ($response->is_success()) |
|---|
| 95 | { |
|---|
| 96 | print "Download failed.\n" . $response->status_line() . "\nExiting.\n"; |
|---|
| 97 | exit; |
|---|
| 98 | } |
|---|
| 99 | my $data = $response->content(); |
|---|
| 100 | print "Downloaded " . int((do {use bytes; length($data)}) / 1024) . "KB.\n"; |
|---|
| 101 | |
|---|
| 102 | if ($response->header('Content-Encoding') |
|---|
| 103 | and |
|---|
| 104 | $response->header('Content-Encoding') eq 'gzip') |
|---|
| 105 | { |
|---|
| 106 | print "Unzipping.\n"; |
|---|
| 107 | $data = Compress::Zlib::memGunzip($data); |
|---|
| 108 | #$data = Compress::Zlib::memGunzip($response->content()); |
|---|
| 109 | } |
|---|
| 110 | |
|---|
| 111 | print "Decoding HTML.\n"; |
|---|
| 112 | HTML::Entities::decode($data); |
|---|
| 113 | |
|---|
| 114 | print "Transforming XMLTVIDs.\n"; |
|---|
| 115 | $data =~ s/channel="(.*)"/'channel="'.subme($1).'"'/ge; |
|---|
| 116 | |
|---|
| 117 | print "Writing output.\n"; |
|---|
| 118 | open (OUT, ">$output_file"); |
|---|
| 119 | print OUT $data; |
|---|
| 120 | close OUT; |
|---|
| 121 | |
|---|
| 122 | print "Done.\n"; |
|---|
| 123 | |
|---|
| 124 | sub subme |
|---|
| 125 | { |
|---|
| 126 | my $station = shift; |
|---|
| 127 | |
|---|
| 128 | foreach (@clist) |
|---|
| 129 | { |
|---|
| 130 | return $channels->{$_} if ($station =~ /$_/i); |
|---|
| 131 | } |
|---|
| 132 | print "Warning: station \"$station\" unknown.\n"; |
|---|
| 133 | return $station; |
|---|
| 134 | } |
|---|