root/grabbers/oztivo @ 900

Revision 900, 13.8 kB (checked in by paul, 6 years ago)

increase timeouts
Line 
1#!/usr/bin/perl -w
2
3# OzTivo grabber
4
5my $version = '1.13';
6
7# Requires configuration!
8# 1. Register at http://www.tvguide.org.au/
9# 2. Run "./oztivo --configure" to create "oztivo.pw" file.
10
11use strict;
12
13use Getopt::Long;
14use HTML::Entities;
15use POSIX;
16use Shepherd::Common;
17
18my $progname = 'oztivo';
19my $nicename = 'OzTivo';
20my $config_file = "$progname.pw";
21my $output_file = "output.xmltv";
22my $channels_file;
23my $channels, my $opt_channels;
24my @clist;
25my $ver;
26my $ready;
27my $configure;
28my $raw_input;
29my $raw_output;
30my $d;
31
32print "$nicename Grabber v$version\n";
33
34$| = 1;
35
36GetOptions( 
37            'channels_file=s'   => \$channels_file,
38            'output=s'          => \$output_file,
39            'rawoutput=s'       => \$raw_output,
40            'rawinput=s'        => \$raw_input,
41            'version'           => \$ver,
42            'ready'             => \$ready,
43            'configure'         => \$configure
44          );
45
46exit 0 if ($ver);
47
48configure() if ($configure);
49
50unless (-r $config_file)
51{
52    print "Can't find $config_file!\n";
53    please_configure_me();
54    exit 1;
55}
56
57print "Reading configuration file $config_file.\n";
58
59unless (open(CONF, $config_file))
60{
61    print "Unable to read config file $config_file: $!\n";
62    please_configure_me();
63    exit 1;
64}
65my $line = <CONF>;
66close CONF;
67
68unless ($line =~ /^(.*):(.*)$/)
69{
70    print "Unable to parse config file!\n" .
71          "It should be in the format: username:password\n";
72    please_configure_me();
73    exit 1;
74}
75my ($user, $pw) = ($1, $2);
76
77unless ($user and $pw)
78{
79    print "Failed to extract a sensible username and password from config file.\n";
80    please_configure_me();
81    exit 1;
82}
83
84exit 0 if ($ready);
85
86unless ($channels_file)
87{
88    die "No --channels_file specified.\n";
89}
90
91unless( -r $channels_file)
92{
93    die "Unable to read channels file $channels_file: $!";
94}
95local (@ARGV, $/) = ($channels_file);
96eval <>;
97die "\nError in channels file!\nDetails:\n$@" if ($@);
98
99my $shortchannels;
100while (my ($name, $chanid) = each %$channels) 
101{
102  # Ignore differences between rural stations like
103  # Seven (Rockhampton) and Seven (Cairns) -- this is not a great
104  # solution and should be fixed.
105  $name =~ s/ *\(.*?\)//g;
106  # Ignore differences between rural stations like
107  # Prime Tamworth/Taree/Port,Prime Lismore/Coffs Hbr -- this is not a great
108  # solution and should be fixed.
109  $name = "Prime" if $name =~ /^Prime/;
110  $shortchannels->{$name} = $chanid;
111}
112
113# Create a list of channel names from longest to shortest
114@clist = sort { length $b <=> length $a } keys %$shortchannels;
115
116my $data;
117
118if (!defined $raw_input) {
119    my ($success, $status);
120
121    # Don't rely on Shepherd::Common::get_url()'s retry, because
122    # if we get a 401 (wrong password) there's no point in retrying.
123    my $max_tries = 3;
124    foreach my $tries (1 .. $max_tries) {
125        ($data, $success, $status) = Shepherd::Common::get_url(
126                url => "http://$user:$pw\@minnie.tuhs.org/tivo-bin/xmlguide.pl",
127                retries => 0);
128
129        unless ($success)
130        {
131            if ($status =~ /401/)
132            {
133                print "Your OzTivo username and/or password may be incorrect!\n".
134                        "The username and password you supplied when configuring the oztivo grabber\n" .
135                        "must match your registration details on the OzTivo.com site.\n".
136                        "If this error persists, try reconfiguring: ".
137                        "  tv_grab_au --configure $progname\n";
138                $tries = $max_tries;
139            }
140            print "Download failed: $status\n";
141        }
142
143        my $bytes = do { use bytes; length($data) };
144        my $sleep = 47;
145
146        # If we get a special message from the oztivo server, sleep
147        # a longer time before retrying.
148        if ($bytes < 1000 and defined $data and $data =~ /<message>(.*?)<\/message>/si)
149        {
150            $success = 0;
151            print "OzTivo message: $1\n";
152            # Giveup unless message says to try again later
153            # eg. OzTivo message: System load on minnie is too high right now to run your request. Please try again later.
154            $tries = $max_tries unless $1 =~ /try\s+again\s+later/si;
155            $sleep = 93 + int(rand(120));
156        }
157        last if ($success);
158        exit 6 if $tries == $max_tries; 
159        print "Sleeping for $sleep seconds...\n";
160        sleep($sleep);
161    }
162
163    if (defined $raw_output) {
164        open(F,">$raw_output") || die "could not write raw output to $raw_output: $!\n";
165        print F $data;
166        close(F);
167        print "Raw output saved in $raw_output.\n";
168    }
169} else {
170    open(F,"<$raw_input") || die "could not read raw input from $raw_input: $!\n";
171    while(<F>) {
172        $data .= $_;
173    }
174    close(F);
175    print "Raw input read from $raw_input.\n";
176}
177
178print "Converting apostrophes.\n";
179$data =~ s/\&#39;/'/g;
180
181# Adjust ABC2 times if we're in a non-DST zone but Sydney is in DST.
182# Apparently ABC2 times are set off Sydney's clock.
183adjust_abc2();
184
185print "Transforming XMLTVIDs.\n";
186&setup_channel_mappings;
187$data =~ s/channel="(.*)"/'channel="'.subme($1).'"'/ge;
188
189print "Writing output.\n";
190open (OUT, ">$output_file") || die "could not write to $output_file: $!\n";
191
192#
193# oztivo generates invalid XMLTV with fields out of order and
194# some blank fields.
195# the standard XMLTV.pm perl module gets very unhappy about these
196# write output in a manner which addresses the bad input
197#
198
199my @xmltv_tag_order = qw [ title sub-title desc credits date category language
200        orig-language length icon url country episode-num video audio
201        previously-shown permiere last-chance new subtitles rating
202        star-rating ];
203my %xmltv_tags = map { $_ => "" } @xmltv_tag_order;
204$xmltv_tags{"programme"}=""; $xmltv_tags{"/programme"}="";
205my $cur_field = "";
206
207foreach my $line (split/\n/,$data) {
208
209    # oztivo generates blank data for these fields - skip if blank
210    next if ($line =~ /<director><\/director>/);
211    next if ($line =~ /<desc><\/desc>/);
212    next if ($line =~ /^\s*$/);
213
214    # more oztivo weirdness. filter out 0/10 star-ratings
215    next if ($line =~ /<star-rating><value>0\/10</);
216
217    if ($line =~ /\s*<([\/a-zA-Z\-]+)/) {
218        my $field = lc($1);
219        # do we know about this tag?
220        $cur_field = $field if (defined $xmltv_tags{$field});
221    }
222
223    if ($cur_field eq "programme") {
224        # if we have a start="(time)" and/or stop="(time)" make sure they
225        # have a timezone on them.
226        $line = $1."start=\"".$2." +0000\"".$3 if ($line =~ /^(.*)start="([0-9]+)"(.*)/);
227        $line = $1."stop=\"".$2." +0000\"".$3 if ($line =~ /^(.*)stop="([0-9]+)"(.*)/);
228
229        print OUT $line."\n"; # programme tag
230        $cur_field = "";
231    } elsif ($cur_field eq "/programme") {
232        print "Program with no title!\n" 
233                if (($xmltv_tags{title} eq "") or ($xmltv_tags{title} =~ />\s*</));
234        # print all previously seen tags in xmltv_tag_order
235        foreach my $xmltag (@xmltv_tag_order) {
236            if ($xmltv_tags{$xmltag} ne "") {
237                print OUT $xmltv_tags{$xmltag};
238                $xmltv_tags{$xmltag} = "";
239            }
240        }
241        print OUT $line."\n"; # /programme tag
242        $cur_field = "";
243    } else {
244        if ($cur_field eq "") {
245            print OUT $line."\n"; # ?xml, tv and /tv tags
246        } else {
247            $xmltv_tags{$cur_field} .= $line."\n"; # xmltv_tags tags
248        }
249    }
250}
251
252close OUT;
253
254print "Done.\n";
255
256
257
258sub please_configure_me
259{
260    print "If you wish to use $nicename, please run \"" .
261          "tv_grab_au --configure $progname\".\n" .
262          "Configuration of $progname is required.\n";
263}
264
265sub configure
266{
267    print "Configuring...\n\n" .
268          "Before you can use the $nicename grabber, you must create an\n" .
269          "OzTivo account here:\n\n" .
270          '  http://minnie.tuhs.org/twiki/bin/view/TWiki/TWikiRegistration' .
271          "\n\n" .
272          "... and select some channels here:\n\n" .
273          '  http://minnie.tuhs.org/tivo-bin/tvguide.pl' . "\n\n" .
274          "When you're done, enter your username and password here, to\n" .
275          "enable this grabber to retrieve your guide data automatically:\n\n" .
276          "Username?\n";
277    my $username = <>;
278    chomp $username;
279    unless ($username)
280    {
281        print "No username supplied. Exiting configuration.\n";
282        exit 3;
283    }
284    print "Password?\n";
285    my $pw = <>;
286    chomp $pw;
287    unless ($pw)
288    {
289        print "No password supplied. Exiting configuration.\n";
290        exit 3;
291    }
292    print "Creating config file $config_file...\n";
293    open (CONF, ">$config_file")
294        or die "Unable to create $config_file: $!";
295    print CONF "$username:$pw";
296    close CONF;
297
298    print "Done.\n";
299    exit 0;
300}
301
302sub subme
303{
304    my $station = shift;
305
306    $station = $d->{chan_map}->{$station} if (defined $d->{chan_map}->{$station});
307    $station =~ s/SC10/Sthn Cross TEN/g; # clashes with TEN but @clist is sorted longest to shortest
308
309    my $num = $1 if ($station =~ /(\d{2,})/);
310    foreach my $ch (@clist)
311    {
312        if ($station =~ /$ch/i
313                or
314            ($num and $ch =~ /$num/))
315        {
316            return $shortchannels->{$ch};
317        }
318    }
319
320    return $opt_channels->{$station} if ((defined $opt_channels) && (defined $opt_channels->{$station}));
321   
322    if (!defined $d->{ignored_channels}->{$station}) {
323        $d->{ignored_channels}->{$station} = 1;
324        print "Warning: station \"$station\" unknown.\n";
325    }
326    return $station;
327}
328
329sub setup_channel_mappings
330{
331    # unmaped Foxtel channels: AdultsOnly960,FOXTELBoxOffice,FOXTELGamesworld,MainEvent
332    # unmaped SelecTV channels: AntennaGreek,ERTGreek
333    my %map = (
334        "SBS-NEWS" => "SBS NEWS",
335
336        "ACC" => "ACC",
337        "ADV1" => "NatGeoAdventure",
338        "ANIMAL" => "AnimalPlanet",
339        "ANT" => "AntennaPacific",
340        "ARNA" => "ARENATV",
341        "ARNA+2" => "ARENATV2",
342        "AUR" => "Aurora",
343        "BBC" => "BBCWorld",
344        "BIOG" => "Bio",
345        "BLM" => "BloombergTelevision",
346        "BOOM" => "Boomerang",
347        "CART" => "CartoonNetwork",
348        "CLAS" => "FOXClassics",
349        "CLAS+2" => "FOXClassics2",
350        "CMC" => "CountryMusicChannel",
351        "CMDY" => "THECOMEDYCHANNEL",
352        "CMDY+2" => "THECOMEDYCHANNEL2",
353        "CNBC" => "CNBC",
354        "CNNI" => "CNN",
355        "CRIME" => "CrimeandInvestigation",
356        "DISC" => "DiscoveryChannel",
357        "DISCRT" => "DiscoveryRealTime",        # SelecTV and OzTivo
358        "DISN" => "DisneyChannel",
359        "E!" => "E!Entertainment",
360        "ESPN" => "ESPN",
361        "EUROSPORT" => "Eurosportnews",
362        "EXPO" => "EXPO",
363        "FASH" => "FashionTV",
364        "FOOD" => "LifeStyleFOOD",
365        "FOX8" => "FOX8",
366        "FOX8+2" => "FOX82",
367        "FOXN" => "FOXNews",
368        "FS1" => "FOXSPORTS1",
369        "FS2" => "FOXSPORTS2",
370        "FS3" => "FOXSPORTS3",
371        "FSN" => "FOXSPORTSNews",
372        "FUEL" => "FUELTV",
373        "HALL" => "Hallmark",
374        "HEALTH" => "DiscoveryHealth",
375        "HIST" => "TheHistoryChannel",
376        "HOWTO" => "HOWTOChannel",
377        "LIFE" => "TheLifeStyleChannel",
378        "LIFE+2" => "LifestyleChannel2",
379        "MOV1" => "MOVIEONE",
380        "MOV1+2" => "MOVIETWO",
381        "MOVG" => "MOVIEGREATS",
382        "MOVX" => "MOVIEEXTRA",
383        "MTV" => "MTV",
384        "NGEO" => "NationalGeographic",
385        "NICK" => "Nickelodeon",
386        "NICKJR" => "NickJr",
387        "OVAT" => "Ovation",
388        "PHDISN" => "PlayhouseDisney",
389        "RAI" => "RAIInternational",
390        "SCIENCE" => "DiscoveryScience",
391        "SHOW" => "SHOWTIME",
392        "SHW2" => "SHOWTIME2",
393        "SHWGRTS" => "SHOWTIMEGreats",
394        "SKYN" => "SkyNewsAustralia",
395        "SKYR" => "SkyRacing",
396        "Sci-Fi" => "SCIFI",
397        "TCM" => "TCM",
398        "TRAVEL" => "DiscoveryTravel",
399        "TV1" => "TV1",
400        "TV1+2" => "TV12",
401        "TVCHILE" => "TVChileSpanish",          # SelecTV and OzTivo
402        "TVE" => "TVE",                         # SelecTV and OzTivo
403        "TVN" => "TVN",
404        "TVSN" => "TVSN",
405        "TWC" => "TheWeatherChannel",
406        "UKTV" => "UKTV",
407        "UKTV+2" => "UKTV2",
408        "V" => "ChannelV",
409        "V2" => "ChannelV2",
410        "VH1" => "VH1",
411        "W" => "W",
412        "W+2" => "W2",
413        "WMOV" => "WORLDMOVIES",
414        "max" => "MAX"
415    );
416
417    foreach (keys %map)
418    {
419        $d->{chan_map}->{$_} = $map{$_};
420    }
421}
422
423# Wrapper sub to ensure TZ gets reset properly
424sub adjust_abc2
425{
426    adjust_abc2_times();
427    POSIX::tzset();
428}
429
430sub adjust_abc2_times
431{
432    my $local_tz = POSIX::strftime("%z",localtime);
433
434    local %ENV;
435    $ENV{TZ} = 'Australia/Sydney';
436    my $sydney_tz = POSIX::strftime("%z",localtime);
437
438    # Okay, I can't believe how hard this is... compute difference
439    # between two TZ strings.
440    my $l_min = int($local_tz / 100) * 60 + $local_tz % 100 % 60; 
441    my $s_min = int($sydney_tz / 100) * 60 + $sydney_tz % 100 % 60; 
442    my $tz_diff = int(($l_min - $s_min) / 60) * 100 + (($l_min - $s_min) % 60);
443
444    # Are we in DST?
445    my $local_dst = (localtime)[8];
446    my $sydney_dst = 0;
447    if (!$local_dst)
448    {
449        # Is Sydney in DST?
450        $sydney_dst = compare_sydney_dst();
451
452        if ($sydney_dst)
453        {
454            print "DST in Sydney but not here: adding 1hr to ABC2 times" .
455                  ($sydney_dst != 1 ? ($sydney_dst > 1 ? 
456                          " from $sydney_dst GMT" : 
457                          " until " . ($sydney_dst*-1) . ' GMT') : '') .
458                  ".\n";
459        }
460    }
461    $data =~ s/(?!=")(\d+)(?=".* channel="ABC2")/$1.add_offset($1,$tz_diff,$sydney_dst)/ge;
462}
463
464# Return '+0100' for any times that are in a period when Sydney's in DST
465# but we're not.
466sub add_offset
467{
468    my ($timestamp, $tz_diff, $sydney_dst) = @_;
469
470    if ($sydney_dst == 1
471            or
472        ($sydney_dst > 1 and $timestamp >= $sydney_dst)
473            or
474        ($sydney_dst < 0 and $timestamp <= ($sydney_dst*-1)))
475    {
476        $tz_diff += 0100;
477    }
478    return sprintf " %+0.4d", $tz_diff;
479}
480
481# Returns:
482# 0         : Sydney is not in DST in the next 7 days
483# 1         : Sydney is in DST for the next 7 days
484# <n>       : Sydney is in DST from <n> GMT, where n is (eg) 20070321030000
485# <-n>      : Sydney is in DST until <n> GMT, where n is (eg) -20070321030000
486# This func assumes that TZ has been set to Sydney by the caller (adjust_abc2_times)
487sub compare_sydney_dst
488{
489    my $sydney_dst = (localtime)[8];
490
491    # Normalize $start to 3AM Sydney time, or 2AM if it's in DST
492    my $start = time - (time % (60*60*24)) - (($sydney_dst ? 11 : 10) * 60*60) + (3*60*60);
493
494    # Check Sydney's DST status each day for 7 days
495    for (my $day = 0; $day < 7; $day++)
496    {
497        my $t = $start + ($day * 24*60*60);
498        my $sydney_dst_thisday = (localtime($t))[8];
499
500        # Any changeover?
501        if ($sydney_dst_thisday != $sydney_dst)
502        {
503            # Convert $t to GMT
504            $t -= (($sydney_dst ? 11 : 10) * 60*60);
505            my $changeoverday = POSIX::strftime("%Y%m%d%H%M%S", localtime($t));
506            $changeoverday *= -1 if ($sydney_dst);
507            return $changeoverday;
508        }
509    }
510    return $sydney_dst;
511}
Note: See TracBrowser for help on using the browser.