root/grabbers/abc2_website @ 4

Revision 4, 16.1 kB (checked in by max, 7 years ago)

Lincoln's updated XMLTV analysis.
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3# abc2_website au_tv guide grabber - runs from "Shepherd" master grabber
4#  * written by ltd
5#  * uses ABC website for ABC2 data ((http://www.abc.net.au/tv/guide/)
6#  * when used in conjunction with Shepherd, shepherd can collect other channels
7#    using other grabbers
8#  * this does NOT use any config file - all settings are passed in from shepherd
9
10#  changelog:
11#    1.50  22sep06      added support for "shepherd" master grabber script
12#    1.51  02oct06      --ready option
13#    1.52  03oct06      split out abc grabber into its own grabber
14
15use strict;
16
17my $progname = "abc2_website";
18my $version = "1.53_03oct06";
19
20use LWP::UserAgent;
21use Time::HiRes qw(gettimeofday tv_interval);
22use XMLTV;
23use POSIX qw(strftime mktime);
24use Getopt::Long;
25use HTML::TreeBuilder;
26use Data::Dumper;
27use Cwd;
28
29#
30# some initial cruft
31#
32
33my $script_start_time = [gettimeofday];
34my %stats;
35my $channels;
36my $tv_guide;
37my $data_cache;
38
39# lets make sure we look exactly like the yahoo widget engine...
40my $ua;
41BEGIN {
42        $ua = LWP::UserAgent->new(
43                'timeout' => 30,
44                'keep_alive' => 1,
45                'agent' => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-us)'
46                );
47        $ua->env_proxy;
48        # $ua->cookie_jar({});
49        $| = 1;
50}
51
52#
53# parse command line
54#
55
56my $opt_days =          7;                              # default
57my $opt_offset =        0;                              # default
58my $opt_timezone =      "1000";                         # default
59my $opt_outputfile =    cwd() . "/abc2_website.xmltv";  # default
60my $opt_configfile =    cwd() . "/abc2_website.conf";   # ignored
61my $opt_cache_file =    cwd() . "/abc2_website.cache";  # ignored
62my $opt_channels_file=  "";
63my $opt_no_cache =      0;
64my $opt_fast =          0;
65my $opt_warper =        0;
66my $opt_obfuscate =     0;
67my $opt_no_extra_days = 0;
68my $opt_help =          0;
69my $opt_version =       0;
70my $opt_desc =          0;
71my $opt_dont_retry =    0;
72my $debug =             1;
73my $lang =              "en";
74my $region =            94;
75my $time_offset =       0;
76
77GetOptions(
78        'region=i'      => \$region,
79        'days=i'        => \$opt_days,
80        'offset=i'      => \$opt_offset,
81        'timezone=s'    => \$opt_timezone,
82        'channels_file=s' => \$opt_channels_file,
83        'output=s'      => \$opt_outputfile,
84        'config-file=s' => \$opt_configfile,
85        'cache-file=s'  => \$opt_cache_file,
86        'no-extra-days' => \$opt_no_extra_days,
87        'fast'          => \$opt_fast,
88        'no-cache'      => \$opt_no_cache,
89        'debug+'        => \$debug,
90        'warper'        => \$opt_warper,
91        'lang=s'        => \$lang,
92        'obfuscate'     => \$opt_obfuscate,
93        'no-retry'      => \$opt_dont_retry,
94        'help'          => \$opt_help,
95        'verbose'       => \$opt_help,
96        'version'       => \$opt_version,
97        'ready'         => \$opt_version,
98        'desc'          => \$opt_desc,
99        'v'             => \$opt_help);
100
101&help if ($opt_help);
102
103if ($opt_version || $opt_desc) {
104        printf "%s %s\n",$progname,$version;
105        printf "%s is a details-aware grabber that collects decent quality data using the ABC website for ABC2 only.",$progname if $opt_desc;
106        exit(0);
107}
108
109die "no channel file specified, see --help for instructions\n", if ($opt_channels_file eq "");
110
111#
112# go go go!
113#
114
115# normalize starttime to an hour..
116my $starttime = time;
117my ($sec,$min,@rest) = localtime($starttime);
118$starttime -= ((60 * $min) + $sec);
119my $endtime = $starttime + (($opt_no_extra_days ? $opt_days : 30) * 86400);
120$starttime += (86400 * $opt_offset);
121
122&log(sprintf "going to grab %s%d%s days%s of data into %s (%s%s%s)",
123        ($opt_no_extra_days ? "" : "somewhere between "),
124        $opt_days,
125        ($opt_no_extra_days ? "" : " to 30"),
126        ($opt_offset ? " (skipping first %d days)" : ""),
127        $opt_outputfile,
128        ($opt_fast ? "with haste" : "slowly"),
129        ($opt_warper ? ", anonymously" : ""),
130        ($opt_no_cache ? ", without caching" : ", with caching"));
131
132# read channels file
133if (-r $opt_channels_file) {
134        local (@ARGV, $/) = ($opt_channels_file);
135        no warnings 'all'; eval <>; die "$@" if $@;
136} else {
137        die "WARNING: channels file $opt_channels_file could not be read\n";
138}
139
140&read_cache if ($opt_no_cache == 0);
141&get_abc_data($starttime,$endtime,"ABC2",$channels->{ABC2},"http://www.abc.net.au/tv/guide/abc2");
142&write_cache if ($opt_no_cache == 0);
143
144&write_data;
145&print_stats;
146exit(0);
147
148######################################################################################################
149# help
150
151sub help
152{
153        print<<EOF
154$progname $version
155
156options are as follows:
157        --help                  show these help options
158        --days=N                fetch 'n' days of data (default: $opt_days)
159        --output=file           send xml output to file (default: "$opt_outputfile")
160        --config-file=file      (ignored - historically used by grabbers not not this one)
161        --no-cache              don't use a cache to optimize (reduce) number of web queries
162        --cache-file=file       where to store cache (default "$opt_cache_file")
163        --fast                  don't run slow - get data as quick as you can - not recommended
164        --debug                 increase debug level
165        --warper                fetch data using WebWarper web anonymizer service
166        --obfuscate             pretend to be a proxy servicing multiple clients
167        --no-extra-days         don't fetch extra (30 days) from ABC website
168        --no-retry              if webserver is rejecting our request, don't retry (default: do retry)
169        --lang=[s]              set language of xmltv output data (default $lang)
170
171        --shepherd              set if being called from the shepherd script
172        --region=N              set region for where to collect data from (default: $region)
173        --channels_file=file    where to get channel data from (if not set manually)
174        --timezone=HHMM         timezone for channel data (default: $opt_timezone)
175EOF
176;
177
178        exit(0);
179}
180
181######################################################################################################
182# populate cache
183
184sub read_cache
185{
186        if (-r $opt_cache_file) {
187                local (@ARGV, $/) = ($opt_cache_file);
188                no warnings 'all'; eval <>; die "$@" if $@;
189        } else {
190                printf STDERR "WARNING: no programme cache $opt_cache_file - have to fetch all details\n";
191
192                # try to write to it - if directory doesn't exist this will then cause an error
193                &write_cache;
194        }
195}
196
197######################################################################################################
198# write out updated cache
199
200sub write_cache
201{
202        if (!(open(F,">$opt_cache_file"))) {
203                printf STDERR "WARNING: could not write cache file $opt_cache_file: $!\n";
204                printf STDERR "Please fix this in order to reduce the number of queries for data!\n";
205                sleep 10;
206        } else {
207                # cleanup old entries from cache
208                for my $cache_key (keys %{$data_cache}) {
209                        my ($starttime, $endtime, $channel, $progname) = split(/,/,$cache_key);
210                        if ($starttime < (time-86400)) {
211                                delete $data_cache->{$cache_key};
212                                $stats{removed_items_from_cache}++;
213                        }
214                }
215                print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
216                close F;
217        }
218}
219
220######################################################################################################
221
222sub add_cached_data
223{
224        my ($channel,$starttime,$cache_key) = @_;
225        $tv_guide->{$channel}->{data}->{$starttime}->{'sub-title'} =    [[ $data_cache->{$cache_key}->{subtitle}, $lang ]] if $data_cache->{$cache_key}->{subtitle};
226        $tv_guide->{$channel}->{data}->{$starttime}->{'desc'} =         [[ $data_cache->{$cache_key}->{desc}, $lang ]] if $data_cache->{$cache_key}->{desc};
227        $tv_guide->{$channel}->{data}->{$starttime}->{'category'} =     [[ $data_cache->{$cache_key}->{genre}, $lang ]] if $data_cache->{$cache_key}->{genre};
228}
229
230######################################################################################################
231
232sub get_abc_data
233{
234        my ($starttime,$endtime,$channel,$xmlid,$urlbase) = @_;
235        my $try_to_add_abc_detail;
236        my $unprocessed_programmes = 0;
237        my $stop_fetching = 0;
238        my @unprocessed_progname, my @unprocessed_starttime, my @unprocessed_url;
239
240        for (my $currtime = $starttime; $currtime < $endtime; $currtime += 86400) {
241                # for abc portal data, treat a faulure as a hint that there is no further data.
242                # sometimes they have as much as 30 days of data ahead.  sometimes much less...
243                if ($stop_fetching == 0) {
244                        my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
245
246                        my $url = sprintf "%s/%s.htm",$urlbase,(strftime "%Y%m/%Y%m%d",localtime($currtime));
247                        my $status = sprintf "%s summary data: day %d of %d", $xmlid, ((($currtime-$starttime)/86400)+1),(($endtime-$starttime)/86400);
248                        my $data = &get_url($url,$status,1);
249                        my $seen_programmes = 0;
250
251                        if ($data) {   
252                                my $tree = HTML::TreeBuilder->new_from_content($data);
253                                for ($tree->look_down('_tag' => 'div', 'class' => 'scheduleDiv')) {
254                                        foreach my $tree_tr ($_->look_down('_tag' => 'tr')) {
255                                                if (my $tree_row = $tree_tr->look_down('_tag' => 'th', 'scope' => 'row')) {
256                                                        if ($tree_row->as_text() =~ /^(\d+):(\d+)(.)m/) {
257                                                                $timeattr[2] = $1; # hour
258                                                                $timeattr[2] += 12 if ($3 eq "p"); # pm
259                                                                $timeattr[1] = $2; # min
260                                                                my $found_time = mktime(@timeattr);
261       
262                                                                if ($tree_tr->look_down('_tag' => 'td')) {
263                                                                        if ($_ = $tree_tr->look_down('_tag' => 'a')) {
264                                                                                my $programme = $_->as_text();
265                                                                                my $progurl = $_->attr('href');
266               
267                                                                                if ($progurl =~ /^\/tv\/guide\//) {
268                                                                                        $unprocessed_progname[$unprocessed_programmes] = $programme;
269                                                                                        $unprocessed_starttime[$unprocessed_programmes] = $found_time;
270                                                                                        $unprocessed_url[$unprocessed_programmes] = "http://www.abc.net.au".$progurl;
271                                                                                        $unprocessed_programmes++;
272                                                                                        $seen_programmes++;
273                                                                                }
274                                                                        }
275                                                                }
276                                                        }
277                                                }
278                                        }
279                                }
280                        }
281       
282                        if ($seen_programmes == 0) {
283                                $stop_fetching = 1;
284                        } else {
285                                $stats{abc_daily_pages}++;
286                        }
287                }
288        }
289
290        # have 'n' days of this channel unprocessed - process it!
291        for (my $i = 0; $i < ($unprocessed_programmes-1); $i++) {
292                $stats{programmes}++;
293                my $starttime = $unprocessed_starttime[$i];
294                my $endtime = $unprocessed_starttime[$i+1];
295                my $cache_key = sprintf "%d,%d,%s,%s", $starttime, $endtime, $xmlid, $unprocessed_progname[$i];
296
297                $tv_guide->{$channel}->{data}->{$starttime}->{'channel'} =      $xmlid;
298                $tv_guide->{$channel}->{data}->{$starttime}->{'start'} =        strftime "%Y%m%d%H%M %z", localtime($starttime);
299                $tv_guide->{$channel}->{data}->{$starttime}->{'stop'} =         strftime "%Y%m%d%H%M %z", localtime($endtime);
300                $tv_guide->{$channel}->{data}->{$starttime}->{'title'} =        [[ $unprocessed_progname[$i], $lang ]];
301
302                if ($data_cache->{$cache_key}) {
303                        $stats{used_cached_data}++;
304                        &add_cached_data($channel,$starttime,$cache_key);
305                } else {
306                        &get_one_abc_event($channel, $cache_key, $unprocessed_url[$i], "$xmlid detail pages ($i of $unprocessed_programmes)");
307                }
308        }
309}
310
311######################################################################################################
312
313sub get_one_abc_event
314{
315        my ($channel, $cache_key, $url, $status) = @_;
316        my $seen_programme = 0;
317        my ($starttime, $endtime, $xmlid, $progname) = split(/,/,$cache_key);
318
319        do {
320                my $data = &get_url($url,$status);
321
322                my $tree = HTML::TreeBuilder->new_from_content($data);
323                if (my $inner_tree = $tree->look_down('_tag' => 'div', 'class' => 'column2')) {
324                        my $event_title = undef, my $event_subtitle = undef, my $event_description = undef, my $event_genre = undef;
325
326                        if (my $prog_h2 = $inner_tree->look_down('_tag' => 'h2')) {
327                                my $full_title = $prog_h2->as_HTML();
328                                ($event_title,$event_subtitle) = split(/<br>/,$full_title);
329
330                                $event_title =~ s/(<[a-zA-Z0-9]+\>)//g; # remove html tags
331                                $event_title =~ s/(^\n|\n$)//g;         # strip trailing/leading blank lines
332
333                                $event_subtitle =~ s/(<[\/a-zA-Z0-9]+\>)//g;    # remove html tags
334                                $event_subtitle =~ s/(^\n|\n$)//g;              # strip trailing/leading blank lines
335                        }
336                       
337                        my $paranum = 0;
338                        foreach my $para ($inner_tree->look_down('_tag' => 'p')) {
339                                $paranum++;
340
341                                if (($paranum > 1) && (!($para->as_text() =~ /^Go to website/)) && (!($para->as_text() =~ /^Send to a Friend/))) {
342                                        $event_description .= $para->as_text() . "\n";
343
344                                        if (my $try_genre = $para->look_down('_tag' => 'a')) {
345                                                $event_genre = $try_genre->as_text();
346                                        }
347                                }
348                        }
349                        $stats{portal_detail_pages}++;
350                        $seen_programme++;
351
352                        $data_cache->{$cache_key}->{subtitle} = $event_subtitle if $event_subtitle;
353                        $data_cache->{$cache_key}->{desc} = $event_description if $event_description;
354                        $data_cache->{$cache_key}->{genre} = $event_genre if $event_genre;
355                        &add_cached_data($channel,$starttime,$cache_key);
356                }
357                if ($seen_programme == 0) {
358                        printf STDERR "WARNING: failed to parse any programme data from '%s' - blocked/rate-limited/format-changed?\n",$url;
359                        $stats{failed_to_parse_portal_detail_page}++;
360                }
361        } until (($seen_programme> 0) || ($opt_dont_retry>0));
362}
363
364######################################################################################################
365# logic to fetch a page via http
366#  retries up to 3 times to get a page with 5 second pauses inbetween
367
368sub get_url
369{
370        my ($url,$status,$dontretry) = @_;
371        my $response;
372        my $attempts = 0;
373        my ($raw, $page, $base);
374
375        $url =~ s#^http://#http://webwarper.net/ww/# if $opt_warper;
376        my $request = HTTP::Request->new(GET => $url);
377        $request->header('Accept-Encoding' => 'gzip');
378
379        if ($opt_obfuscate) {
380                my $randomaddr = sprintf "203.%d.%d.%d",rand(255),rand(255),(rand(254)+1);
381                $request->header('Via' => '1.0 proxy:81 (Squid/2.3.STABLE3)');
382                $request->header('X-Forwarded-For' => $randomaddr);
383        }
384        &log(sprintf "fetching %s%s: %s",$status,($opt_obfuscate ? "[obfuscate]" : ""),$url);
385        for (1..3) {
386                $response = $ua->request($request);
387                last if ($response->is_success || $dontretry);
388
389                $stats{http_failed_requests}++;
390                $stats{slept_for} += 10;
391                $attempts++;
392                sleep 10;
393        }
394        if (!($response->is_success)) {
395                if ($dontretry == 0) {
396                        &log("aborting after $attempts attempts to fetch url $url") if $debug;
397                        printf STDERR "ERROR: could not open url %s in %d attempts\n",$url,$attempts;
398                }
399                return undef;
400        }
401
402        $stats{bytes_fetched} += do {use bytes; length($response->content)};
403        $stats{http_successful_requests}++;
404
405        if (!$opt_fast) {
406                my $sleeptimer = int(rand(5)) + 1;  # sleep anywhere from 1 to 5 seconds
407                $stats{slept_for} += $sleeptimer;
408                sleep $sleeptimer;
409        }
410
411        if ($response->header('Content-Encoding') &&
412            $response->header('Content-Encoding') eq 'gzip') {
413                $stats{compressed_pages} += do {use bytes; length($response->content)};
414                $response->content(Compress::Zlib::memGunzip($response->content));
415        }
416        return $response->content;
417}
418
419######################################################################################################
420
421sub log
422{
423        my ($entry) = @_;
424        printf STDERR "%s [%d] %s\n",$progname,time,$entry;
425}
426
427######################################################################################################
428
429sub print_stats
430{
431        printf STDERR "%s v%s [%d] completed in %0.2f seconds",$progname,$version,time,tv_interval($script_start_time);
432        foreach my $key (sort keys %stats) {
433                printf STDERR ", %d %s",$stats{$key},$key;
434        }
435        printf STDERR "\n";
436}
437
438######################################################################################################
439# descend a structure and clean up various things, including stripping
440# leading/trailing spaces in strings, translations of html stuff etc
441#   -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
442
443my %amp;
444BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
445
446sub cleanup {
447        my $x = shift;
448        if    (ref $x eq "REF")   { cleanup($_) }
449        elsif (ref $x eq "HASH")  { cleanup(\$_) for values %$x }
450        elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
451        elsif (defined $$x) {
452                $$x =~ s/&(#(\d+)|(.*?));/ $2 ? chr($2) : $amp{$3}||' ' /eg;
453                # $$x =~ s/[^\x20-\x7f]/ /g;
454                $$x =~ s/(^\s+|\s+$)//g;
455        }
456}
457
458######################################################################################################
459
460sub write_data
461{
462        my %writer_args = ( encoding => 'ISO-8859-1' );
463        if ($opt_outputfile) {
464                my $fh = new IO::File(">$opt_outputfile")  or die "can't open $opt_outputfile: $!";
465                $writer_args{OUTPUT} = $fh;
466        }
467
468        my $writer = new XMLTV::Writer(%writer_args);
469
470        $writer->start
471          ( { 'source-info-url'    => "about:blank",
472              'source-info-name'   => "$progname $version",
473              'generator-info-name' => "$progname $version"} );
474
475        for my $channel (sort keys %{$channels}) {
476                $writer->write_channel( {
477                        'display-name' => [[ $channel, $lang ]],
478                        'id' => $channels->{$channel}
479                        } );
480        }
481
482        for my $channel (sort keys %{$channels}) {
483                for my $event_id (sort {$a <=> $b} keys %{($tv_guide->{$channel}->{data})}) {
484                        my $show = $tv_guide->{$channel}->{data}->{$event_id};
485                        &cleanup($show);
486                        $writer->write_programme($show);
487                }
488        }
489
490        $writer->end();
491}
492
493######################################################################################################
Note: See TracBrowser for help on using the browser.