source: trunk/grabbers/sbsnews_website

Last change on this file was 1129, checked in by paul, 10 years ago

sbsnews_website: handle time slot with no name

  • Property svn:executable set to *
File size: 15.1 KB
Line 
1#!/usr/bin/perl -w
2
3# sbsnews_website au_tv guide grabber - runs from "Shepherd" master grabber
4#  * written by ltd
5#  * uses SBS website for SBSNEWS data
6#    (http://www.sbs.com.au/whatson/WNC-Schedule.html)
7#  * when used in conjunction with Shepherd, shepherd can collect other channels
8#    using other grabbers
9#  * this does NOT use any config file - all settings are passed in from shepherd
10#  * now uses http://www.sbs.com.au/schedule/digital
11
12#  changelog:
13#    0.01 24oct06      initial release
14#    1.00 24jun08      paul rewrote for new web address
15
16use strict;
17
18my $progname = "sbsnews_website";
19my $version = "1.02";
20
21use XMLTV;
22use POSIX qw(strftime);
23use Getopt::Long;
24use HTML::TreeBuilder;
25use Shepherd::Common;
26#use Data::Dumper::Simple;
27
28#
29# some initial cruft
30#
31
32my $script_start_time = time;
33my %stats;
34my $channels, my $opt_channels, my $gaps;
35
36$| = 1;
37
38#
39# parse command line
40#
41
42my $opt;
43$opt->{days} =          7;      # default
44$opt->{offset} =        0;      # default
45$opt->{outputfile} =    "output.xmltv"; # default
46$opt->{channels_file} =  "";    # mandatory for user to specify
47$opt->{debug} =         0;      # default
48$opt->{lang} =          "en";   # default
49
50GetOptions(
51        'region=i'      => \$opt->{region},     # ignored
52        'timezone=s'    => \$opt->{timezone},   # ignored
53        'config-file=s' => \$opt->{configfile}, # ignored
54        'days=i'        => \$opt->{days},
55        'offset=i'      => \$opt->{offset},
56        'channels_file=s' => \$opt->{channels_file},
57        'gaps_file=s'   => \$opt->{gaps_file},
58        'output=s'      => \$opt->{outputfile},
59        'debug+'        => \$opt->{debug},
60        'lang=s'        => \$opt->{lang},
61        'help'          => \$opt->{help},
62        'verbose'       => \$opt->{help},
63        'version'       => \$opt->{version},
64        'ready'         => \$opt->{version},
65        'v'             => \$opt->{help});
66
67&help if ($opt->{help});
68
69if ($opt->{version}) {
70        printf "%s %s\n",$progname,$version;
71        printf "Collects news lineup for SBSNEWS from SBS Web site." if $opt->{desc};
72        exit(0);
73}
74
75die "no channel file specified, see --help for instructions\n", if ($opt->{channels_file} eq "");
76
77#
78# go go go!
79#
80
81&log(sprintf "going to %sfetch %d days%s of data into %s",
82        (defined $opt->{gaps_file} ? "micro-gap " : ""),
83        $opt->{days},
84        ($opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
85        $opt->{outputfile});
86
87# read channels file
88if (-r $opt->{channels_file}) {
89        local (@ARGV, $/) = ($opt->{channels_file});
90        no warnings 'all'; eval <>; die "$@" if $@;
91} else {
92        die "WARNING: channels file $opt->{channels_file} could not be read: $!\n";
93}
94
95# unless we have SBSNEWS defined as a channel, nothing to do!
96
97die "no SBSNEWS channel found in channel lineup from $opt->{channels_file}\n"
98  unless (defined $channels->{'SBS News'});
99
100if (defined $opt->{gaps_file}) {
101        if (-r $opt->{gaps_file}) {
102                local (@ARGV, $/) = ($opt->{gaps_file});
103                no warnings 'all'; eval <>; die "$@" if $@;
104        } else {
105                die "WARNING: gaps file $opt->{gaps_file} could not be read: $!\n";
106        }
107
108        die "no SBSNEWS channel in gaps lineup, nothing to do!\n"
109          unless ((defined $gaps) && (defined $gaps->{'SBS News'}));
110}
111
112my $week = &get_sbsnews_data();
113$week = &fix_gaps($week);
114&write_data($week);
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        --debug                 increase debug level
131        --lang=[s]              set language of xmltv output data (default $opt->{lang})
132        --channels_file=file    where to get channel data from
133        --gaps_file=file        micro-fetch gaps only
134
135EOF
136;
137
138        exit(0);
139}
140
141######################################################################################################
142
143sub log
144{
145        my ($entry) = @_;
146        printf "%s\n",$entry;
147}
148
149######################################################################################################
150
151sub print_time
152{
153        my $t = shift;
154        return sprintf "%02d:%02d",$t/(60*60),$t/60%60;
155}
156
157######################################################################################################
158
159sub nice_time
160{
161        my $t = shift;
162        return POSIX::strftime("%Y%m%d%H%M",localtime($t));
163}
164
165######################################################################################################
166
167sub print_stats
168{
169        printf "STATS: %s v%s completed in %d seconds",$progname, $version, (time-$script_start_time);
170        foreach my $key (sort keys %stats) {
171                printf ", %d %s",$stats{$key},$key;
172        }
173        printf "\n";
174}
175
176######################################################################################################
177
178sub cook_data
179{
180        my $raw = shift;
181        my $time_column = shift;
182        my $title_column = shift;
183        my $week = shift;
184        my $day = shift;
185
186        my $row = 0; my $started = 0;
187        my $previous_start_time = 0; my $previous_stop_time = 0;
188        my $next_12hours_start = 0; my $next_12hours_stop = 0;
189        my $seen_24_time = 0;
190        while (1) {
191                die "Possible infinite loop, too many rows!" if $row >= 100;
192                #print $raw->{$time_column}->{$row}->{title} . "\n";
193                #print $raw->{$title_column}->{$row}->{title} . "\n";
194
195                my ($start_time, $stop_time);
196                if ($raw->{$time_column}->{$row}->{title} &&
197                                $raw->{$title_column}->{$row}->{title} &&
198                                $raw->{$time_column}->{$row}->{title} =~
199                                /^(\d{1,2})[:.](\d{1,2})(?:\s*\-\s*(\d{1,2})[:.](\d{1,2}))?$/) {
200                        $started=1;
201
202                        $start_time = ($1*60*60)+($2*60);
203                        $seen_24_time = 1 if $1 >= 13;
204                        $start_time += (12*60*60) if $next_12hours_start;
205                        if (!$seen_24_time) {
206                                if ($start_time < $previous_start_time) {
207                                        if (!$next_12hours_start) {
208                                                $next_12hours_start = 1;
209                                                $start_time += (12*60*60);
210                                        } else {
211                                                $next_12hours_start = 0;
212                                                $start_time -= (12*60*60);
213                                        }
214                                }
215                                if ($start_time >= (24*60*60)) {
216                                        $next_12hours_start = 0;
217                                        $start_time -= (24*60*60);
218                                }
219                        }
220
221                        if ($3 && $4) {
222                                $stop_time = ($3*60*60)+($4*60);
223                                $seen_24_time = 1 if $3 >= 13;
224                                $stop_time += (12*60*60) if $next_12hours_stop;
225                                if (!$seen_24_time) {
226                                        if ($stop_time < $previous_stop_time) {
227                                                if (!$next_12hours_stop) {
228                                                        $next_12hours_stop = 1;
229                                                        $stop_time += (12*60*60);
230                                                } else {
231                                                        $next_12hours_stop = 0;
232                                                        $stop_time -= (12*60*60);
233                                                }
234                                        }
235                                        if ($stop_time >= (24*60*60)) {
236                                                $next_12hours_stop = 0;
237                                                $stop_time -= (24*60*60);
238                                        }
239                                }
240                        } else {
241                                $stop_time = $start_time;
242                        }
243
244                        if ($start_time > $stop_time) {
245                                $stop_time += (24*60*60);
246                        } elsif ($previous_stop_time > $start_time) {
247                                $day = ($day + 1) % 7;
248                        }
249                        $previous_start_time = $start_time;
250                        $previous_stop_time = $stop_time;
251                } else {
252                        $row += 1;
253                        if (!$started) {
254                                next;
255                        } else {
256                                last;
257                        }
258                }
259
260                #print "$day ".&print_time($start_time)." ".&print_time($stop_time)."\n";
261
262                #print "$raw->{$title_column}->{$row}->{title}\n";
263                my $title = $raw->{$title_column}->{$row}->{title};
264                $title =~ s/\xA0/ /g; # &nbsp; can be &#160; == &#xA0;
265                $title =~ s/^\s+//s;
266                $title =~ s/\s+$//s;
267
268                if ($title) {
269                        my $prog;
270                        $prog->{channel} = $channels->{'SBS News'};
271                        $prog->{start} = $start_time;
272                        $prog->{stop} = $stop_time if ($stop_time != $start_time);
273                        $prog->{title} = [[ $title, $opt->{lang} ]];
274                        $prog->{'sub-title'} = [[ $raw->{$title_column}->{$row}->{subtitle}, $opt->{lang} ]]
275                                        if $raw->{$title_column}->{$row}->{subtitle};
276                        $prog->{category} = [[ 'News', undef ]]
277                                        if ($raw->{$title_column}->{$row}->{title} =~ /News/i);
278                        &Shepherd::Common::cleanup($prog);
279
280                        $week->{$day}->{$start_time} = $prog;
281
282                        #warn Dumper($prog);
283                }
284
285                $row += 1;
286        };
287        #print "$day = $row\n";
288
289        return $week;
290}
291
292sub get_sbsnews_data
293{
294        my $file = "WNC-Schedule.html";
295
296        # 7 days in one URL: http://www.sbs.com.au/whatson/WNC-Schedule.html
297        my $data = &Shepherd::Common::get_url( url => "http://www.sbs.com.au/schedule/digital",
298                    stats => \%stats,
299                    retries => 4,
300                    debug => $opt->{debug} ? 3 : 1,
301                    retry_delay => 120,
302                    # the website doesn't support 'If-Modified-Since' headers but we can live in hope
303                    mirror => $file);
304
305        $data = &Shepherd::Common::get_mirror_file($file, 14) if (!$data);
306
307        exit 22 unless ($data);
308
309        # read html
310        my $tree = HTML::TreeBuilder->new_from_content($data);
311        my $table = $tree->look_down('_tag' => 'div', id => 'digital_list');
312        die "Format has changed can't find digital_list\n" unless ($table);
313        my $raw;
314        my ($column, $row) = (0,0);
315        foreach my $ul ($table->look_down('_tag' => 'ul')) {
316                foreach my $li ($ul->look_down('_tag' => 'li')) {
317                        my $title = $li->as_trimmed_text();
318                        my $subtitle = $li->look_down('_tag' => 'span');
319                        if (defined $subtitle) {
320                                $subtitle = $subtitle->as_trimmed_text();
321                                $title =~ s/$subtitle//;
322                        } else {
323                                $subtitle = "";
324                        }
325                        #print "$title<$subtitle\t";
326                        $raw->{$column}->{$row}->{title} = $title;
327                        $raw->{$column}->{$row}->{subtitle} = $subtitle;
328                        $row += 1;
329                }
330                #print "\n";
331                $row = 0;
332                $column += 1;
333        }
334        $tree->delete;
335        die "didn't find any programmes!  has the HTML format changed?\n" unless ($column==9);
336
337        # make ideal week
338        #my %day_range_names = (sunday=>0,monday=>1,tuesday=>2,wednesday=>3,thursday=>4,friday=>5,saturday=>6);
339        my $week;
340        foreach my $day (0 .. 6) {
341                if ($day == 0) {
342                        $week = cook_data($raw, 8, 7, $week, $day)
343                } else {
344                        $week = cook_data($raw, 0, $day, $week, $day)
345                }
346        }
347
348        return $week;
349}
350
351######################################################################################################
352
353sub fix_gaps
354{
355        my $week = shift;
356
357        &log("Extending stop times to fill in small guide data holes.");
358
359        my @day_names = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday");
360
361        my @list = sort {$b <=> $a} keys %{$week->{0}};
362        my $prev_start = $list[$#list] + (24*60*60);
363
364        for (my $day=6; $day >= 0; $day--) {
365                @list = sort {$b <=> $a} keys %{$week->{$day}};
366
367                foreach my $start (@list) {
368                        if (!defined $week->{$day}->{$start}->{stop}) {
369                                my $start = $week->{$day}->{$start}->{start};
370
371                                if ($week->{$day}->{$start}->{title}->[0]->[0] =~ /Weather\s*Watch/i ||
372                                                ((($prev_start - $start) / (60*60)) < 3)) { # fix long gaps
373                                        $week->{$day}->{$start}->{stop} = $prev_start;
374                                } else {
375                                        my $new_stop = $start + (60*60); # make it an one hour show
376                                        $week->{$day}->{$start}->{stop} = $new_stop;
377                                        my $new_day = $day;
378                                        if ($new_stop >= (24*60*60)) {
379                                                $new_stop -= (24*60*60);
380                                                $prev_start -= (24*60*60);
381                                                $new_day = ($day + 1) % 7;
382                                        }
383                                        my $new_prog = { title => [[ 'Weather Watch', $opt->{lang} ]],
384                                                        channel => $channels->{'SBS News'},
385                                                        start => $new_stop,
386                                                        stop => $prev_start };
387                                        &log(sprintf "Inserting 'Weather Watch' on %s between %s to %s",
388                                                        $day_names[$new_day],
389                                                        &print_time($new_prog->{start}),
390                                                        &print_time($new_prog->{stop}));
391                                        $week->{$new_day}->{$new_stop} = $new_prog;
392                                        $prev_start = $new_stop;
393                                        $stats{gap_add_close}++;
394                                }
395                        }
396       
397                        my $stop = $week->{$day}->{$start}->{stop};
398
399                        if ($stop != $prev_start) {
400                                my $diff = $prev_start - $stop;
401                                my $new_day = $day;
402                                if ($stop >= (24*60*60)) {
403                                        $stop -= (24*60*60);
404                                        $prev_start -= (24*60*60);
405                                        $new_day = ($day + 1) % 7;
406                                }
407
408                                # Gaps of at least 30 minutes before 7am are Station Closes
409                                if ($diff / 60 >= 30 and (($prev_start % (24*60*60)) <= (7*60*60))) {
410                                        my $new_prog = { title => [[ 'Station Close', $opt->{lang} ]],
411                                                        channel => $channels->{'SBS News'},
412                                                        start => $stop,
413                                                        stop => $prev_start };
414                                        &log(sprintf "Inserting \"Station Close\" on %s between %s to %s",
415                                                        $day_names[$new_day],
416                                                        &print_time($new_prog->{start}),
417                                                        &print_time($new_prog->{stop}));
418                                        $week->{$new_day}->{$stop} = $new_prog;
419                                        $stats{gap_add_close}++;
420
421                                # Gaps of 15 or more minutes in other times are genuine holes
422                                } elsif ($diff / 60 >= 15) {
423                                        my $new_prog = { title => [[ 'Gap', $opt->{lang} ]],
424                                                        channel => $channels->{'SBS News'},
425                                                        start => $stop,
426                                                        stop => $prev_start };
427                                        &log(sprintf "Inserting \"Gap\" on %s between %s to %s",
428                                                        $day_names[$new_day],
429                                                        &print_time($new_prog->{start}),
430                                                        &print_time($new_prog->{stop}));
431                                        $week->{$new_day}->{$stop} = $new_prog;
432                                        $stats{gap_add_gap}++;
433
434                                # Gaps of <15 minutes shall be filled in
435                                } else {
436                                        &log(sprintf "Extending stop time of \"%s\" by %d mins, from %s to %s on %s.", 
437                                                $week->{$day}->{$start}->{title}[0][0],
438                                                $diff/60,
439                                                &print_time($week->{$day}->{$start}->{stop}),
440                                                &print_time($week->{$day}->{$start}->{stop} + $diff),
441                                                $day_names[$day]) if ($opt->{debug});
442                                        $week->{$day}->{$start}->{stop} += $diff;
443                                        $stats{gap_extended_stops}++;
444                                }
445                        }
446                        $prev_start = $start;
447                }
448                $prev_start += (24*60*60);
449        }
450        return $week;
451}
452
453######################################################################################################
454
455sub write_data
456{
457        my $week = shift;
458
459        my %writer_args = ( encoding => 'ISO-8859-1' );
460        my $fh = new IO::File(">$opt->{outputfile}") || die "can't open $opt->{outputfile}: $!";
461        $writer_args{OUTPUT} = $fh;
462
463        my $writer = new XMLTV::Writer(%writer_args);
464
465        $writer->start
466          ( { 'source-info-name'   => "$progname $version",
467              'generator-info-name' => "$progname $version"} );
468        $writer->write_channel( {
469                'display-name' => [[ 'SBS News', $opt->{lang} ]],
470                'id' => $channels->{'SBS News'} } );
471
472        my $currday = $script_start_time;
473        my @today = localtime($currday); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
474        # set currday back to match midnight.
475        $currday -= (($today[0]) + ($today[1]*60) + ($today[2]*60*60));
476
477        foreach my $offset ($opt->{offset} .. ($opt->{days}-1)) {
478                my $day = ($today[6] + $offset) % 7;
479                my $remove;
480
481                # fill gap at start of first day
482                if ($offset == $opt->{offset}) {
483                        my $prev_day = $day - 1;
484                        $prev_day = 6 if $prev_day < 0;
485
486                        my @sorted_starts = (sort {$a <=> $b} keys %{$week->{$prev_day}});
487                        my $last_prog = { %{$week->{$prev_day}->{$sorted_starts[$#sorted_starts]}}};
488
489                        if ($last_prog->{stop} > (24*60*60)) {
490                                $last_prog->{start} = $last_prog->{start} - (24*60*60);
491                                $last_prog->{stop} = $last_prog->{stop} - (24*60*60);
492
493                                $week->{$day}->{$last_prog->{start}} = $last_prog;
494                                $remove = $last_prog->{start};
495                        }
496                }
497
498                foreach my $start (sort {$a <=> $b} keys %{$week->{$day}}) {
499                        my $start_time = $currday + $offset*(24*60*60) + $week->{$day}->{$start}->{start};
500                        my $stop_time = $currday + $offset*(24*60*60) + $week->{$day}->{$start}->{stop};;
501
502                        # if we are fetching microgaps, skip if this isn't
503                        # in a micro-gap
504                        if (defined $opt->{gaps_file}) {
505                                my $found_gap_match = 0;
506                                foreach my $g (@{($gaps->{'SBS News'})}) {
507                                        my ($s, $e) = split(/-/,$g);
508
509                                        $found_gap_match = 1 if
510                                           ((($s >= $start_time) &&
511                                             ($s <= $stop_time)) ||
512                                            (($e >= $start_time) &&
513                                             ($e <= $stop_time)) ||
514                                            (($s <= $start_time) &&
515                                             ($e >= $stop_time)));
516                                }
517                                if (!$found_gap_match) {
518                                        $stats{gaps_skipped}++;
519                                        next;
520                                } else {
521                                        $stats{gaps_included}++;
522                                }
523                        }
524
525                        my $prog = { %{$week->{$day}->{$start}}};
526                        $prog->{start} = &nice_time($start_time);
527                        $prog->{stop} = &nice_time($stop_time);
528
529                        $writer->write_programme($prog);
530                        $stats{progs}++;
531                }
532
533                if ($remove) {
534                        delete $week->{$day}->{$remove};
535                }
536        }
537
538        $writer->end();
539}
540
541######################################################################################################
Note: See TracBrowser for help on using the repository browser.