root/grabbers/ninemsn @ 256

Revision 256, 23.4 kB (checked in by lincoln, 7 years ago)

initial rev of ninemsn grabber, not debugged yet
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3# ninemsn au_tv guide grabber - runs from "Shepherd" master grabber
4#  * grabs data from NineMSN (http://tvguide.ninemsn.com.au/)
5#  * this does NOT use any config file - all settings are passed in from shepherd
6#  * roughly based on Michael 'Immar' Smith's excellent original
7#    ninemsn tv_grab_au script but essentially rewritten
8
9use strict;
10
11my $progname = "ninemsn";
12my $version = "0.01";
13
14use LWP::UserAgent;
15use XMLTV;
16use POSIX qw(strftime mktime);
17use Getopt::Long;
18use HTML::TreeBuilder;
19use Data::Dumper;
20use Cwd;
21use JavaScript;
22
23#
24# global variables and settings
25#
26
27$| = 1;
28my $script_start_time = time;
29my %stats;
30my $channels, my $opt_channels;
31my $data_cache;
32my $writer;
33my %already_seen;
34my $d;
35my $jsc;
36my $ua;
37my $opt;
38
39#
40# parse command line
41#
42
43$opt->{days} =          7;                              # default
44$opt->{outputfile} =    cwd() . "/ninemsn.xmltv";       # default
45$opt->{cache_file} =    cwd() . "/ninemsn.cache";       # default
46$opt->{lang} =          "en";
47$opt->{region} =        94;
48
49GetOptions(
50        'region=i'      => \$opt->{region},
51        'days=i'        => \$opt->{days},
52        'offset=i'      => \$opt->{offset},
53        'timezone=s'    => \$opt->{timezone},
54        'channels_file=s' => \$opt->{channels_file},
55        'output=s'      => \$opt->{outputfile},
56        'cache-file=s'  => \$opt->{cache_file},
57        'fast'          => \$opt->{fast},
58        'no-cache'      => \$opt->{no_cache},
59        'no-details'    => \$opt->{no_details},
60        'debug+'        => \$opt->{debug},
61        'warper'        => \$opt->{warper},
62        'lang=s'        => \$opt->{lang},
63        'obfuscate'     => \$opt->{obfuscate},
64        'help'          => \$opt->{help},
65        'verbose'       => \$opt->{help},
66        'version'       => \$opt->{version},
67        'ready'         => \$opt->{version},
68        'v'             => \$opt->{help});
69
70&help if ($opt->{help});
71
72if ($opt->{version}) {
73        printf "%s %s\n",$progname,$version;
74        exit(0);
75}
76
77die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
78$opt->{days} = 7 if ($opt->{days} > 7); # limit to a max of 7 days
79
80&log("WARNING: JavaScript version ".$JavaScript::VERSION." is too old. Please use at least version 0.55.")
81  if $JavaScript::VERSION < 0.55;
82
83
84#
85# go go go!
86#
87
88&log(sprintf "going to grab %d days%s of data into %s (%s%s%s)",
89        $opt->{days},
90        (defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
91        $opt->{outputfile},
92        (defined $opt->{fast} ? "with haste" : "slowly"),
93        (defined $opt->{warper} ? ", anonymously" : ""),
94        (defined $opt->{no_details} ? ", without details" : ", with details"),
95        (defined $opt->{no_cache} ? ", without caching" : ", with caching"));
96
97# read channels file
98if (-r $opt->{channels_file}) {
99        local (@ARGV, $/) = ($opt->{channels_file});
100        no warnings 'all'; eval <>; die "$@" if $@;
101} else {
102        die "WARNING: channels file $opt->{channels_file} could not be read\n";
103}
104
105&read_cache unless (defined $opt->{no_cache});
106
107&setup_javascript;
108&start_writing_xmltv;
109
110&fetch;
111
112&write_cache unless (defined $opt->{no_cache});
113$writer->end();
114
115&print_stats;
116exit(0);
117
118##############################################################################
119# help
120
121sub help
122{
123        print<<EOF
124$progname $version
125
126options are as follows:
127        --help                  show these help options
128        --days=N                fetch 'n' days of data (default: $opt->{days})
129        --output=file           send xml output to file (default: "$opt->{outputfile}")
130        --no-cache              don't use a cache to optimize (reduce) number of web queries
131        --no-details            don't fetch detailed descriptions (default: do)
132        --cache-file=file       where to store cache (default "$opt->{cache_file}")
133        --fast                  don't run slow - get data as quick as you can - not recommended
134        --debug                 increase debug level
135        --warper                fetch data using WebWarper web anonymizer service
136        --obfuscate             pretend to be a proxy servicing multiple clients
137        --lang=[s]              set language of xmltv output data (default $opt->{lang})
138
139        --region=N              set region for where to collect data from (default: $opt->{region})
140        --channels_file=file    where to get channel data from
141EOF
142;
143
144        exit(0);
145}
146
147##############################################################################
148# populate cache
149
150sub read_cache
151{
152        if (-r $opt->{cache_file}) {
153                local (@ARGV, $/) = ($opt->{cache_file});
154                no warnings 'all'; eval <>; die "$@" if $@;
155
156                my $cache_items = 0;
157                foreach (keys %{$data_cache}) {
158                        $cache_items++;
159                }
160                &log("$cache_items programmes loaded from cache.");
161        } else {
162                printf "WARNING: no programme cache $opt->{cache_file} - have to fetch all details\n";
163
164                # try to write to it - if directory doesn't exist this will then cause an error
165                &write_cache;
166        }
167}
168
169##############################################################################
170# write out updated cache
171
172sub write_cache
173{
174        if (!(open(F,">$opt->{cache_file}"))) {
175                printf "ERROR: could not write cache file $opt->{cache_file}: $!\n";
176                printf "Please fix this in order to reduce the number of queries for data!\n";
177                exit 1;
178        } else {
179                # cleanup old entries from cache
180                for my $cache_key (keys %{$data_cache}) {
181                        my ($starttime, @rest) = split(/:/,$cache_key);
182                        if ($starttime < (time-86400)) {
183                                delete $data_cache->{$cache_key};
184                                $stats{expired_from_cache}++;
185                        }
186                }
187                print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
188                close F;
189        }
190}
191
192##############################################################################
193# logic to fetch a page via http
194#  retries up to $retrycount times to get a page with 10 second pauses inbetween
195
196sub get_url
197{
198        my ($url,$retrycount) = @_;
199        my $response;
200        my $attempts = 0;
201        my ($raw, $page, $base);
202
203        $retrycount = 5 if ($retrycount == 0);
204        $url =~ s#^http://#http://webwarper.net/ww/# if (defined $opt->{warper});
205
206        my $request = HTTP::Request->new(GET => $url);
207        $request->header('Accept-Encoding' => 'gzip');
208
209        if ($opt->{obfuscate}) {
210                my $randomaddr = sprintf "203.%d.%d.%d",rand(255),rand(255),(rand(254)+1);
211                $request->header('Via' => '1.0 proxy:81 (Squid/2.3.STABLE3)');
212                $request->header('X-Forwarded-For' => $randomaddr);
213        }
214        for (1..$retrycount) {
215                $response = $ua->request($request);
216                last if ($response->is_success);
217
218                $stats{http_failed_requests}++;
219                $attempts++;
220                &log("attempt $attempts to fetch $url failed: ".$response->status_line);
221
222                $stats{slept_for} += 10;
223                sleep 10;
224
225                &refresh_ua;
226        }
227        if (!($response->is_success)) {
228                &log("aborting after $attempts attempts to fetch url $url");
229                return undef;
230        }
231
232        $stats{bytes_fetched} += do {use bytes; length($response->content)};
233        $stats{http_successful_requests}++;
234
235        if (!$opt->{fast}) {
236                my $sleeptimer = int(rand(5)) + 1;  # sleep anywhere from 1 to 5 seconds
237                $stats{slept_for} += $sleeptimer;
238                sleep $sleeptimer;
239        }
240
241        if ($response->header('Content-Encoding') &&
242            $response->header('Content-Encoding') eq 'gzip') {
243                $stats{compressed_pages} += do {use bytes; length($response->content)};
244                $response->content(Compress::Zlib::memGunzip($response->content));
245        }
246        return $response->content;
247}
248
249##############################################################################
250
251sub log
252{
253        my ($entry) = @_;
254        printf "%s [%d] %s\n",$progname,time,$entry;
255}
256
257##############################################################################
258
259sub print_stats
260{
261        printf "%s %s [%d] completed in %d seconds",$progname, $version, time, time-$script_start_time;
262        foreach my $key (sort keys %stats) {
263                printf ", %d %s",$stats{$key},$key;
264        }
265        printf "\n";
266}
267
268##############################################################################
269# descend a structure and clean up various things, including stripping
270# leading/trailing spaces in strings, translations of html stuff etc
271#   -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
272
273my %amp;
274BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
275
276sub cleanup {
277        my $x = shift;
278        if    (ref $x eq "REF")   { cleanup($_) }
279        elsif (ref $x eq "HASH")  { cleanup(\$_) for values %$x }
280        elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
281        elsif (defined $$x) {
282                $$x =~ s/&(#(\d+)|(.*?));/ $2 ? chr($2) : $amp{$3}||' ' /eg;
283                $$x =~ s/[^\x20-\x7f]/ /g;
284                $$x =~ s/(^\s+|\s+$)//g;
285        }
286}
287
288##############################################################################
289
290sub start_writing_xmltv
291{
292        my %writer_args = ( encoding => 'ISO-8859-1' );
293        if ($opt->{outputfile}) {
294                my $fh = new IO::File(">$opt->{outputfile}") || die "can't open $opt->{outputfile}: $!";
295                $writer_args{OUTPUT} = $fh;
296        }
297
298        $writer = new XMLTV::Writer(%writer_args);
299
300        $writer->start
301          ( { 'source-info-name'   => "$progname $version",
302              'generator-info-name' => "$progname $version"} );
303
304        for my $channel (sort keys %{$channels}) {
305                $writer->write_channel( {
306                        'display-name' => [[ $channel, $opt->{lang} ]],
307                        'id' => $channels->{$channel}
308                        } );
309        }
310}
311
312##############################################################################
313
314sub refresh_ua
315{
316        my @agent_list = (
317                'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)',
318                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)',
319                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; FunWebProducts)',
320                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)',
321                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)',
322                'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q312466)',
323                'Mozilla/4.0 (compatible; MSIE 6.0; Windows XP)',
324                'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85.8.5 (KHTML, like Gecko) Safari/85.8.1',
325                'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.4) Gecko/20060508 Firefox/1.5.0.4',
326                'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.7.6) Gecko/20050512 Firefox',
327                'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.8) Gecko/20061025 Firefox/1.5.0.8',
328                'Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1) Gecko/20061010 Firefox/2.0',
329                'Mozilla/5.0 (compatible; Yahoo! Slurp; http://help.yahoo.com/help/us/ysearch/slurp)',
330                'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/412 (KHTML, like Gecko) Safari/412',
331                'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-us) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
332                'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; fr) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
333                'Opera/9.00 (Windows NT 5.1; U; en)');
334
335        $ua = undef;
336        $ua = LWP::UserAgent->new('timeout' => 30, 'keep_alive' => 30, 'agent' => $agent_list[(int(rand($#agent_list+1)))] );
337        $ua->env_proxy;
338        $ua->cookie_jar({});
339}
340
341##############################################################################
342# 1.
343# browse to http://tvguide.ninemsn.com.au/ via
344# http://tvguide.ninemsn.com.au/setlocation.asp?region=<reg>&returnURL=http://tvguide.ninemsn.com.au/
345# and soak up the "day" URLs
346
347sub get_initial_page
348{
349        &refresh_ua;
350        my $url = "http://tvguide.ninemsn.com.au/setlocation.asp?region=".$opt->{region}."&returnURL=http://tvguide.ninemsn.com.au/";
351        &log("setting location: http://tvguide.ninemsn.com.au/");
352        my $data = &get_url($url, 5);
353        if (!$data) {
354                &log("CRITIAL ERROR: ABORTING: could not read initial page '$url'");
355                exit(1);
356        }
357
358        # parse initial page
359        my $tree = HTML::TreeBuilder->new_from_content($data);
360        if (!$tree) {
361                &log("CRITICAL ERROR: ABORTING: could not build tree from data in '$url'");
362                exit(1);
363        }
364
365        # find <select name=day..> tag
366        my $select_day_tag = $tree->look_down('_tag' => 'select', 'name' => 'day');
367        if (!$select_day_tag) {
368                &log("CRITICAL ERROR: ABORTING: could not find a day tag in '$url'");
369                exit(1);
370        }
371
372        # take note of options
373        my $found_options = 0;
374        my @day_values;
375
376        foreach my $opt_tag ($select_day_tag->look_down('_tag' => 'option')) {
377                push (@day_values,$opt_tag->attr('value'));
378                $found_options++;
379
380                printf "DEBUG: day %d tag is '%s'\n",$found_options,$opt_tag->attr('value')
381                  if (defined $opt->{debug});
382        }
383
384        if ($found_options == 0) {
385                &log("CRITICAL ERROR: ABORTING: could not find any day tag options in '$url'");
386                exit(1);
387        }
388}
389
390##############################################################################
391# parse daily pages
392#  return codes: -1=restart, 0=fail but accept, 1=good
393
394sub parse_daily_pages
395{
396        my ($day_opt,$day_start,$day_num) = @_;
397
398        my $url = "http://tvguide.ninemsn.com.au/todaytv/default.asp?channel=free&day=".$day_opt;
399
400        my $progs_in_day = 0;
401
402        my $tries = 0;
403        my $tree;
404        while ((!$tree) && ($tries < 5)) {
405                $tries++;
406                &log("fetching day $day_num summary page (try $tries)");
407                my $data = &get_url($url, 1);
408                $tree = HTML::TreeBuilder->new_from_content($data) if ($data);
409
410                if ((!$data) || (!$tree)) {
411                        &log("failed to read day $day_num summary page.. refreshing..");
412                        &refresh_ua;
413                }
414        }
415
416        if (!$tree) {
417                &log("WARNING: skipping day $day_num: could not fetch '$url' afer 5 attempts: format/URL changed?");
418                return 0;
419        }
420
421        my $table_tag = $tree->look_down('_tag' => 'table', 'class' => 'tv');
422        if (!$table_tag) {
423                &log("WARNING: skipping day $day_num: could not find tv table in '$url': has the format changed?");
424                return 0;
425        }
426
427        my $row_num = 0;
428        my @row_span;   # used to track rowspan= counts
429        my $max_cols;
430
431        foreach my $tree_tr ($table_tag->look_down('_tag' => 'tr')) {
432                if ($row_num == 0) {
433                        #
434                        # parse channels
435                        #
436
437                        my $col_num = 0;
438                        foreach my $tree_td ($tree_tr->look_down('_tag' => 'td')) {
439                                my $ch = $tree_td->as_text();
440       
441                                #
442                                # map channel name to our xmltvids
443                                #
444       
445                                $d->{chan_col}->[$col_num] = $channels->{'Nine'} if ($ch =~ /nine/i);
446                                $d->{chan_col}->[$col_num] = $channels->{'Seven'} if ($ch =~ /seven/i);
447                                $d->{chan_col}->[$col_num] = $channels->{'TEN'} if ($ch =~ /ten/i);
448                                $d->{chan_col}->[$col_num] = $channels->{'SBS News'} if ($ch =~ /SBS NEWS/i);
449                                $d->{chan_col}->[$col_num] = $channels->{'ABC2'} if ($ch =~ /abc2/i);
450       
451                                # we pick these up seperately so as to not confuse ABC/ABC2 / SBS/SBS News
452                                if (!defined $d->{chan_col}->[$col_num]) {
453                                        $d->{chan_col}->[$col_num] = $channels->{'ABC'} if ($ch =~ /abc/i);
454                                        $d->{chan_col}->[$col_num] = $channels->{'SBS'} if ($ch =~ /sbs/i);
455                                }
456       
457                                printf "DEBUG: chan_map col %d '%s' -> %s\n", $col_num, $ch,
458                                  (defined $d->{chan_col}->[$col_num] ? $d->{chan_col}->[$col_num] : "(undef)")
459                                  if (defined $opt->{debug});
460       
461                                &log("Unknown channel '$ch' in column $col_num of '$url'")
462                                  if (!defined $d->{chan_col}->[$col_num]);
463
464                                $row_span[$col_num] = 1; # set initial row_span to 1
465                                $col_num++;
466                        }
467                        $max_cols = $col_num;
468                        printf "DEBUG: set max_cols to $max_cols\n" if (defined $opt->{debug});
469                } else {
470                        #
471                        # parse programmes
472                        #
473
474                        my $col_num = -1;
475                        foreach my $tree_td ($tree_tr->look_down('_tag' => 'td', 'class' => 'tv')) {
476                                $col_num++; # increment at beginning - just easier
477
478                                my $prog;
479                                my $prog_name = $tree_td->as_text();
480                                my $prog_url;
481
482                                # calculate programme starttime, either based on row number
483                                # (each row = 5 mins) or an explicit start time in the prog_name
484                                if ($prog_name =~ s/\s*\[\s* (\d+):(\d+) \s* (am|pm) \s*\]\s* //x) {
485                                        my ($hr, $min, $ampm) = ($1, $2, lc($3));
486                                        $hr = 0 if ($hr == 12);
487                                        $hr += 12 if ($ampm eq "pm");
488                                        $hr += 24 if (($ampm eq "am") && ($hr < 6));
489
490                                        $prog->{starttime} = $day_start + ((60*60)*$hr) + (60*$min);
491
492                                        printf "DEBUG: starttime of prog '%s' explicitly set to %s\n",
493                                          $prog_name, (strftime "%Y%m%d%H%M", localtime($prog->{starttime}))
494                                          if (defined $opt->{debug});
495                                } else {
496                                        $prog->{starttime} = $day_start + ((60*60)*6) + ((5*60)*($row_num-1));
497
498                                        printf "DEBUG: starttime of prog '%s' calculated to be %s based on row %d\n",
499                                          $prog_name, (strftime "%Y%m%d%H%M", localtime($prog->{starttime})),
500                                          $row_num, if (defined $opt->{debug});
501                                }
502
503                                # got a cell.  work out what column it applies to,
504                                # taking into account any rowspans that are going on
505                                while (($col_num < $max_cols) && ($row_span[$col_num] > 1)) {
506                                        printf "DEBUG: row %d column %d skipped due to rowspan (%d)\n",
507                                          $row_num, $col_num, $row_span[$col_num] if (defined $opt->{debug});
508
509                                        $row_span[$col_num]--; # decrease span
510                                        $col_num++; # jump to next column
511                                }
512
513                                if ($col_num == $max_cols) {
514                                        # no longer in a valid column!
515                                        &log("WARNING: Bad HTML (excess columns) in row $row_num of '$url': celltext: '$prog_name'. Format changed?");
516                                        next;
517                                }
518
519                                # set (future) rowspan
520                                if ($tree_td->attr('rowspan')) {
521                                        my $found_span = $tree_td->attr('rowspan');
522
523                                        if ($found_span =~ /^(\d+)$/) {
524                                                $row_span[$col_num] = $found_span;
525                                        } else {
526                                                # a BOGUS span - invalid HTML - who would have thought?!???
527                                                printf "DEBUG: ignored a non-numeric rowspan in row %d column %d: '%s': skipped\n",
528                                                  $row_num, $col_num, $found_span if (defined $opt->{debug});
529                                                next;
530                                        }
531                                }
532
533                                # programme length is based on number of rows spanned
534                                $prog->{stoptime} = $prog->{starttime} + ((5*60)*$row_span[$col_num]);
535
536                                my $prog_a = $tree_td->look_down('_tag' => 'a');
537                                $prog_url = $prog_a->attr('href') if ($prog_a);
538                                       
539                                if (!defined $prog_url) {
540                                        # no url - not a programme?
541                                        &log("WARNING: Bad HTML (no link) in row $row_num column $col_num of '$url': '$prog_name' has no URL. Format changed?");
542                                        next;
543                                }
544
545                                if (!defined $d->{chan_col}->[$col_num]) {
546                                        # no channel for this programme!
547                                        printf "DEBUG: Programme in row $row_num column $col_num had no known channel! ($prog_name)\n"
548                                          if (defined $opt->{debug});
549                                        $stats{skipped_prog_no_channel}++;
550                                        next;
551                                }
552                                $prog->{channel} = $d->{chan_col}->[$col_num];
553                                $prog->{title} = [[ $prog_name, $opt->{lang} ]];
554
555                                #
556                                # got programme, store it for grabbing detailed info in next step
557                                #
558
559                                # set cache key based on day, channel, starttime, cell row and progname
560                                my $cache_key = sprintf "%d:%s:%d:%s", $prog->{starttime}, $prog->{channel}, $row_num, $prog_name;
561                                $progs_in_day++;
562
563                                next if (defined $already_seen{$cache_key}); # already processed this entry!
564
565                                $stats{programmes}++;
566
567                                if ((!defined $data_cache->{$cache_key}) && (!defined $opt->{no_details}) &&
568                                    ($prog_name ne "Station Close")) {
569                                        printf "DEBUG: Fetching detail page: %s: %s\n",
570                                          $prog->{channel}, $prog_url if (defined $opt->{debug});
571
572                                        # not in cache, go fetch additional details if we can
573                                        my $ret = &fetch_one_prog($cache_key, $prog_url, $day_num, $progs_in_day);
574
575                                        if ($ret == -1) {
576                                                # failed - abort!
577                                                return -1;
578                                        }
579
580                                        # if we got additional details, add them now
581                                        if (defined $data_cache->{$cache_key}) {
582                                                foreach my $key (keys %{($data_cache->{$cache_key})}) {
583                                                        $prog->{$key} = $data_cache->{$cache_key}->{$key};
584                                                }
585                                        }
586                                }
587
588                                # if we now have a length field, use that to more explicitly set the
589                                # stop time (we may have got a length field in the detailed data)
590                                $prog->{stop} = $prog->{start} + (60*$prog->{length})
591                                  if (defined $prog->{length});
592
593                                $prog->{start} = strftime "%Y%m%d%H%M", localtime($prog->{starttime});
594                                delete $prog->{starttime};
595
596                                $prog->{stop} = strftime "%Y%m%d%H%M", localtime($prog->{stoptime});
597                                delete $prog->{stoptime};
598
599                                &cleanup($prog);
600                                printf "DEBUG: programme xmltv: ".Dumper($prog) if (defined $opt->{debug});
601                                $writer->write_programme($prog);
602
603                                $already_seen{$cache_key}++;
604                        }
605
606                        # update any remaining rowspan counters
607                        $col_num++;
608                        while (($col_num < $max_cols) && ($row_span[$col_num] > 1)) {
609                                printf "DEBUG: blank row %d: decreasing column %d rowspan (%d)\n",
610                                  $row_num, $col_num, $row_span[$col_num] if (defined $opt->{debug});
611
612                                $row_span[$col_num]--; # decrease span
613                                $col_num++; # jump to next column
614                        }
615                }
616
617                $row_num++;
618        }
619
620        if ($progs_in_day < 50) {
621                &log("WARNING: $progs_in_day programmes seen for day $day_num.  URL/formatting changed? (url $url)");
622                return 0;
623        }
624
625        return 1;
626}
627
628##############################################################################
629
630# fetch one prog:
631#  return codes: -1=restart, 0=fail but accept, 1=good
632
633sub fetch_one_prog
634{
635        my ($cache_key,$url,$day_num,$prog_num) = @_;
636
637        $url = "http://tvguide.ninemsn.com.au".$url if ($url !~ /^http/);
638        $url =~ s/\/closeup\//\/cu\//;
639
640        my $tries = 0;
641        my $data;
642        my $parsed_text = "";
643        while ((!$data) && ($tries < 4)) {
644                $tries++;
645                &log("fetching day $day_num programme $prog_num detail page (try $tries)");
646                $data = &get_url($url, 1);
647
648                if ($data) {
649                        $data =~ s{<script language="?Javascript"?[^>]*>(.*?)</script>}{
650                                my $x = $1;
651                                $jsc->eval(qq{ doc = '' });
652                                $jsc->eval($x);
653                                $parsed_text .= $jsc->eval(qq{ doc }) || '';
654                                }isge;
655
656                        if ($data =~ /we are unable/i) {
657                                &log("got failed page .... restarting at initial page");
658
659                                &log("sleeping for 30 seconds");
660                                sleep 30;
661                                $stats{slept_for} += 30;
662
663                                return -1;
664                        }
665                } else {
666                        &log("failed to read page.. refreshing..");
667                        &refresh_ua;
668                }
669        }
670
671        if (!$data) {
672                &log("WARNING: skipping programme, could not fetch '$url' afer 4 attempts: format/URL changed?");
673                return 0;
674        }
675
676        if ($parsed_text eq "") {
677                &log("WARNING: skipping programme, could not find javascript to execute in '$url': format changed?");
678                return 0;
679        }
680
681        # split HTML up into sections seperated by <BR><BR>
682        my @html_lines = split(/<BR><BR>/,$parsed_text);
683        &cleanup(@html_lines);
684
685        # line 1 contains progname, duration and genre
686        $html_lines[0] =~ s/<.*?>//g;   # note: can fail on complex tags
687        if ($html_lines[0] =~ /\((\d+) mins/) {
688                $data_cache->{$cache_key}->{length} = $1;
689                printf "DEBUG: set 'length' to '%d'\n",$1 if (defined $opt->{debug});
690        }
691        if ($html_lines[0] =~ /Rated: ([^\)]+)\)/) {
692                my @ratings;
693                push(@ratings, [$1, 'ABA', undef]);
694                $data_cache->{$cache_key}->{rating} = [ @ratings ];
695                printf "DEBUG: set 'rating' to '%s'\n",$1 if (defined $opt->{debug});
696        }
697        if ($html_lines[0] =~ /Genre: (.*)$/) {
698                my $cat = translate_category($1);
699                my @categories;
700                push(@categories,$cat,$opt->{lang});
701                $data_cache->{$cache_key}->{category} = [[ @categories ]];
702                printf "DEBUG: set 'category' to '%s'\n",$cat if (defined $opt->{debug});
703        }
704
705        # line 2 contains description
706        if ($html_lines[1] ne "") {
707                $data_cache->{$cache_key}->{desc} = [[ $html_lines[1], $opt->{lang} ]];
708                printf "DEBUG: set desc to '%s'\n",$html_lines[1] if (defined $opt->{debug});
709        }
710
711        return 1;
712}
713
714##############################################################################
715
716sub setup_javascript
717{
718        $jsc = new JavaScript::Runtime->create_context();
719        $jsc->set_error_handler( sub { } );
720 
721        $jsc->eval(qq{
722                var doc = '';
723                function Location() { this.href  = 'http://ninemsn.com.au'; }
724                function Document() { this.write = function(x) { doc += x; } }
725                function Window()   { this.___ww = 0 }
726
727                location = new Location;
728                document = new Document;
729                window   = new Window;
730                });
731}
732
733##############################################################################
734
735sub translate_category
736{
737        my $genre = shift;
738        my %translation = (
739                'Sport' => 'sports',
740                'Soap Opera' => 'Soap',
741                'Science and Technology' => 'Science/Nature',
742                'Real Life' => 'Reality',
743                'Cartoon' => 'Animation',
744                'Family' => 'Children',
745                'Murder' => 'Crime' );
746
747        return $translation{$genre} if defined $translation{$genre};
748        return $genre;
749}
750
751
752##############################################################################
753
754sub fetch
755{
756        my $times_restarted = 0;
757
758  RESTART:
759        my @day_values = &get_initial_page;
760
761        my $starttime = time;
762        my $day_num = 0;
763        my $skip_days = 0;
764
765        $skip_days = $opt->{offset} if (defined $opt->{offset});
766
767        foreach my $day_opt (@day_values) {
768                my $currtime = $starttime + (60*60*24 * $day_num);
769                $day_num++;
770
771                return if ($day_num > $opt->{days});
772
773                # skip if --offset applies against this day
774                if ($skip_days > 0) {
775                        $skip_days--;
776                        next;
777                }
778
779                my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
780                $timeattr[0] = 0; # zero sec
781                $timeattr[1] = 0; # zero min
782                $timeattr[2] = 0; # zero hour
783
784                my $day_start = mktime(@timeattr);
785
786                my $ret = &parse_daily_pages($day_opt,$day_start,$day_num);
787                if ($ret == -1) {
788                        $times_restarted++;
789                        goto RESTART if ($times_restarted < 100);
790                }
791        }
792}
793
794##############################################################################
Note: See TracBrowser for help on using the browser.