source: grabbers/acctv_website @ 935

Last change on this file since 935 was 935, checked in by paul, 11 years ago

Shepherd::Common: add options and help acctv_website: because someone kept asking for it.

  • Property svn:executable set to *
File size: 10.0 KB
Line 
1#!/usr/bin/perl -w
2
3use strict;
4use XMLTV;
5use Shepherd::Common;
6use POSIX qw(strftime mktime);
7use Data::Dumper;
8use HTML::TreeBuilder;
9
10#
11# global variables and settings
12#
13
14$| = 1;
15my $details_cache;
16my $writer;
17my $baseurl = "http://www.acctv.com.au/";
18
19#
20# go go go!
21#
22
23my %stats;
24my $o;
25Shepherd::Common::program_begin(\$o, "acctv_website", "0.01", \%stats);
26
27my ($channels, $opt_channels, $gaps) = Shepherd::Common::read_channels($o, ("ACC"));
28
29&read_cache unless (defined $o->{no_cache});
30&start_writing_xmltv;
31&get_days();
32$writer->end();
33&write_cache unless (defined $o->{no_cache});
34
35Shepherd::Common::program_end($o, %stats);
36exit(0);
37
38##############################################################################
39# populate cache
40
41sub read_cache
42{
43        my $store = Shepherd::Common::read_cache(\$o->{cache_file});
44
45        if ($store) {
46                $details_cache = $store->{details_cache} if (defined $store->{details_cache});
47        }
48}
49
50##############################################################################
51# write out updated cache
52
53sub write_cache
54{
55        # cleanup old prog entries from cache
56        for my $cache_key (keys %{$details_cache}) {
57                # no real way to detect changes so check every four weeks
58                if ($details_cache->{$cache_key}->{added} < ($o->{script_start_time} - (28*24*60*60))) {
59                        delete $details_cache->{$cache_key};
60                        $stats{cache_expire}++;
61                }
62        }
63
64        my $store = { };
65        $store->{details_cache} = $details_cache;
66        Shepherd::Common::write_cache($o->{cache_file}, $store);
67}
68
69##############################################################################
70
71sub start_writing_xmltv
72{
73        my %writer_args = ( encoding => 'ISO-8859-1' );
74        if ($o->{outputfile}) {
75                my $fh = new IO::File(">$o->{outputfile}") || die "can't open $o->{outputfile}: $!";
76                $writer_args{OUTPUT} = $fh;
77        }
78
79        $writer = new XMLTV::Writer(%writer_args);
80
81        $writer->start
82          ( { 'source-info-name' => "$o->{program_name} v$o->{version_number}",
83              'generator-info-name' => "$o->{program_name} v$o->{version_number}"} );
84
85        $writer->write_channel( {'display-name' => [[ "ACC", $o->{lang} ]], 'id' => $opt_channels->{ACC} } );
86}
87
88##############################################################################
89
90sub get_days
91{
92        Shepherd::Common::log("Setting region");
93        my $intnewtzstate = 0;
94        $intnewtzstate = 7 if ($o->{region} =~ /^(126)$/);
95        $intnewtzstate = 0 if ($o->{region} =~ /^(73|184|66|67|63|69|71|106)$/);
96        $intnewtzstate = 6 if ($o->{region} =~ /^(74|108)$/);
97        $intnewtzstate = 2 if ($o->{region} =~ /^(75|78|79|114)$/);
98        $intnewtzstate = 3 if ($o->{region} =~ /^(81|82|83|85|86|107)$/);
99        $intnewtzstate = 5 if ($o->{region} =~ /^(88)$/);
100        $intnewtzstate = 1 if ($o->{region} =~ /^(94|93|90|95|98)$/);
101        $intnewtzstate = 4 if ($o->{region} =~ /^(101|102)$/);
102        my $data = &Shepherd::Common::get_url(url => $baseurl."schedule.asp",
103                        postvars => "intnewtzstate=" . $intnewtzstate);
104
105        my @timeattr = localtime($o->{script_start_time});
106        # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
107        $timeattr[0] = 0; # zero sec
108        $timeattr[1] = 0; # zero min
109        $timeattr[2] = 0; # zero hour
110        $timeattr[3] += $o->{offset}; # day
111        my $first_day = mktime(@timeattr); # don't return anything before first day
112        # guide pages have part days so grab day before
113        $timeattr[3]--; # day
114
115        my $progs;
116        foreach my $day (($o->{offset}-1) .. ($o->{days}-1)) {
117                my $date = mktime(@timeattr);
118                $timeattr[3]++; # day
119       
120                &Shepherd::Common::log("Fetching day $day");
121
122                my $progs_in_day = &get_day($first_day, $date);
123                last if ($progs_in_day == 0 && $day >= 0);
124
125                &Shepherd::Common::log("  found $progs_in_day programmes.");
126        }
127}
128
129##############################################################################
130
131sub get_day
132{
133        my ($first_day, $date) = @_;
134
135        my $url = $baseurl."schedule.asp?day=" . POSIX::strftime("%m%%2F%d%%2F%Y", localtime($date));
136
137        my $data = &Shepherd::Common::get_url($url);
138        if (!$data) {
139                Shepherd::Common::log("Failed to get html for '$url'");
140                $stats{failed_html_get}++;
141                return 0;
142        }
143        Shepherd::Common::log("DEBUG: html: $data") if ((defined $o->{debug}) && ($o->{debug} > 2));
144
145        my $tree = HTML::TreeBuilder->new_from_content($data);
146        if (!$tree) {
147                Shepherd::Common::log("Can't parse html for '$url'");
148                $stats{failed_html_parse}++;
149                return 0;
150        }
151
152        my @tables = $tree->find_by_tag_name('table');
153        if (@tables < 2) {
154                Shepherd::Common::log("Format has changed for '$url'");
155                $stats{failed_html_change}++;
156                return 0;
157        }
158
159        my $progs_in_day = 0;
160        my @tds = $tables[1]->find_by_tag_name('td'); # from second table
161        my $td = shift @tds;
162        my $text = $td->as_trimmed_text() if $td;
163        while (@tds > 0) {
164                my $prog;
165
166                if ($text !~ /(\d+):(\d+) (am|pm)/) { # start
167                        Shepherd::Common::log("skipped   : " . $td->as_HTML()) if $o->{debug};
168                        $td = shift @tds || last;
169                        $text = $td->as_trimmed_text();
170                        next;
171                }
172                $prog->{start} = $date + (($1)*60 + $2)*60;
173                $prog->{start} += 12*60*60 if ($3 eq 'pm' && $1 != 12);
174                $prog->{start} += 24*60*60 if ($3 eq 'am' && $1 < 6);
175                $prog->{start} += 12*60*60 if ($3 eq 'am' && $1 == 12);
176                Shepherd::Common::log("\ntime      : $1:$2 $3  " .
177                                POSIX::strftime("%Y%m%d%H%M", localtime($prog->{start})))
178                                if $o->{debug};
179                $td = shift @tds || last;
180                $text = $td->as_trimmed_text();
181
182                my $a = $td->find_by_tag_name('a') || next; # title
183                $prog->{title} = [[$a->as_trimmed_text(), $o->{lang}]];
184                my $link = $a->attr('href'); # link
185                Shepherd::Common::log("title link: $prog->{title}->[0]->[0] \t$link") if ($o->{debug});
186                $td = shift @tds || goto PART;
187                $text = $td->as_trimmed_text();
188
189        PART:
190                # don't return anything before first day
191                next if ($prog->{start} <= ($first_day - 2*60*60));
192
193                $prog = get_details($prog, $link);
194
195                # don't return anything before first day
196                next if (defined $prog->{stop} && $prog->{stop} <= $first_day);
197
198                $prog->{start} = POSIX::strftime("%Y%m%d%H%M",localtime($prog->{start}));
199                $prog->{stop} = POSIX::strftime("%Y%m%d%H%M",localtime($prog->{stop})) if defined $prog->{stop};
200                $prog->{channel} = $opt_channels->{ACC};
201                push(@{$prog->{'category'}}, ["Religion", $o->{lang}])
202                                if !grep($_->[0] eq "Religion", @{$prog->{'category'}});
203
204                Shepherd::Common::cleanup($prog);
205
206                Shepherd::Common::log("DEBUG: xmltv: ".Dumper($prog))
207                                if ((defined $o->{debug}) && ($o->{debug} > 1));
208
209                $writer->write_programme($prog);
210
211                $progs_in_day++;
212                $stats{programmes}++;
213        }
214
215        $tree->delete();
216
217        Shepherd::Common::log("WARNING: Only $progs_in_day programmes seen for url $url")
218                        if ($progs_in_day < 10);
219
220        return $progs_in_day;
221}
222
223sub get_details
224{
225        my ($prog, $link) = @_;
226
227        my $cache_key = sprintf("%s:%s", $prog->{title}->[0]->[0], $link);
228        if (defined $details_cache->{$cache_key}) {
229                foreach ('desc', 'length', 'category', 'credits') {
230                        next if !defined $details_cache->{$cache_key}->{$_};
231                        Shepherd::Common::log(" cache use $_ \t: $details_cache->{$cache_key}->{$_}") if ($o->{debug});
232                        $prog->{$_} = $details_cache->{$cache_key}->{$_};
233                }
234                if (defined $prog->{length}) {
235                        $prog->{stop} = $prog->{start} + $prog->{length};
236                        delete $prog->{length};
237                }
238                $stats{cached_used}++;
239                return $prog;
240        }       
241
242        my $url = $baseurl . $link;
243        if (($stats{failed_details_html_get} && $stats{failed_details_html_get} > 5) ||
244                ($stats{failed_details_html_parse} && $stats{failed_details_html_parse} > 5) ||
245                ($stats{failed_details_html_change} && $stats{failed_details_html_change} > 5)) {
246                Shepherd::Common::log("Too many errors retrieving details, skipping '$url'");
247                return $prog;
248        }
249
250        my $data = &Shepherd::Common::get_url($url);
251        if (!$data) {
252                Shepherd::Common::log("Failed to get html for details '$url'");
253                $stats{failed_details_html_get}++;
254                return $prog;
255        }
256        Shepherd::Common::log("DEBUG: html: $data") if ((defined $o->{debug}) && ($o->{debug} > 2));
257
258        my $tree = HTML::TreeBuilder->new_from_content($data);
259        if (!$tree) {
260                Shepherd::Common::log("Can't parse html for details '$url'");
261                $stats{failed_details_html_parse}++;
262                return $prog;
263        }
264
265        my @tables = $tree->find_by_tag_name('table');
266        if (@tables < 3) {
267                Shepherd::Common::log("Format has changed for details '$url'");
268                $stats{failed_details_html_change}++;
269                return $prog;
270        }
271
272        my $h4 = $tables[1]->find_by_tag_name('h4') || return; # from second table
273        my $desc = $h4->right();
274        $prog->{desc} = [[$desc, $o->{lang}]] if !ref($desc); # desc
275        Shepherd::Common::log("desc      : $desc") if ($o->{debug});
276
277        my @categories;
278
279        my @tds = $tables[2]->find_by_tag_name('td'); # from third table
280        my $td = shift @tds;
281        my $header = $td->as_trimmed_text() if $td;
282        $header =~ s/[^\x20-\x7f]//g; # remove &nbsp;
283        my $content;
284        while (@tds > 0) {
285                $td = shift @tds || last;
286                $content = $td->as_trimmed_text();
287                Shepherd::Common::log("header content : $header\t$content") if ($o->{debug});
288
289                if ($header eq 'Length') {
290                        if ($content !~ /^(\d+) /) { # length
291                                Shepherd::Common::log("skipped detail length : " . $td->as_HTML()) if $o->{debug};
292                                $td = shift @tds || last;
293                                $header = $td->as_trimmed_text();
294                                next;
295                        }
296                        my $length = ($1 < 3 ? ($1*60*60) : ($1*60));
297                        $prog->{length} = $length;
298                        $prog->{stop} = $prog->{start} + $length;
299                        Shepherd::Common::log("set length     : $length") if ($o->{debug});
300                } elsif ($header eq 'Genre') {
301                        push(@categories, [$content, $o->{lang}]); # category
302                        Shepherd::Common::log("set category   : $content") if ($o->{debug});
303                } elsif ($header eq 'Speaker/Host') {
304                        #Amanda Wells and Chris Byers
305                        my @actors = split(/,|and/, $content);
306                        $prog->{credits}->{actor} = [@actors];  # actor
307                        Shepherd::Common::log("set actors     : @actors") if ($o->{debug});
308                }
309
310                $td = shift @tds || last;
311                $header = $td->as_trimmed_text();
312                $header =~ s/[^\x20-\x7f\x0a]//g; # remove &nbsp;
313        }
314
315        $prog->{category} = [@categories];
316
317        foreach ('desc', 'length', 'category', 'credits') {
318                next if !defined $prog->{$_};
319                Shepherd::Common::log(" cache add $_ \t: $prog->{$_}") if ($o->{debug});
320                $details_cache->{$cache_key}->{$_} = $prog->{$_};
321        }
322        $details_cache->{$cache_key}->{added} = $o->{script_start_time};
323
324        $stats{cached_added}++;
325        if (($stats{cached_added} % 32) == 0)
326        {
327                &write_cache unless (defined $o->{no_cache});
328                Shepherd::Common::log(" cache write");
329        }
330
331        return $prog;
332}
Note: See TracBrowser for help on using the repository browser.