root/trunk/grabbers/channelnsw_gov

Revision 886, 9.8 kB (checked in by max, 5 years ago)

channelnsw_gov: fill hole before 12:30am on day 0, remove redundant &cleanup
  • Property svn:executable set to *
Line 
1#!/usr/bin/perl -w
2
3# channelnsw_gov TV guide grabber
4#  * adapted from sbsnews_website, written by ltd
5#  * gets data from http://www.nsw.gov.au/channelnsw/guide.asp
6#  * does not use any config file - all settings are passed via command-line
7
8#  0.1  04MAY07 First version: no details, just show names & times
9#  0.5  15MAY07 Use Shepherd::Common
10
11use strict;
12
13my $progname = "channelnsw_gov";
14my $version = "0.8";
15my $DATASOURCE = 'http://www.nsw.gov.au/channelnsw';
16my $GUIDE = "$DATASOURCE/guide.asp";
17
18use LWP::UserAgent;
19use XMLTV;
20use POSIX qw(strftime);
21use Getopt::Long;
22use Data::Dumper;
23use HTML::TreeBuilder;
24use Shepherd::Common;
25
26#
27# some initial cruft
28#
29
30my $script_start_time = time;
31my %stats;
32my $channels, my $opt_channels, my $gaps;
33my $tv_guide;
34my $zerohr;
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
50Getopt::Long::Configure(qw/pass_through/);  # Don't complain about unknown options
51GetOptions(
52        'days=i'        => \$opt->{days},
53        'offset=i'      => \$opt->{offset},
54        'channels_file=s' => \$opt->{channels_file},
55        'gaps_file=s'   => \$opt->{gaps_file},
56        'output=s'      => \$opt->{outputfile},
57        'fast'          => \$opt->{fast},
58        'debug+'        => \$opt->{debug},
59        'lang=s'        => \$opt->{lang},
60        'no-retry'      => \$opt->{dont_retry},
61        'help'          => \$opt->{help},
62        'verbose'       => \$opt->{help},
63        'version'       => \$opt->{version},
64        'desc'          => \$opt->{desc},
65        'ready'         => \$opt->{version}
66    );
67
68&help if ($opt->{help});
69
70if ($opt->{version}) {
71        printf "%s %s\n",$progname,$version;
72        printf "Gathers guide data from $DATASOURCE." if $opt->{desc};
73        exit(0);
74}
75
76die "no channel file specified, see --help for instructions\n", if ($opt->{channels_file} eq "");
77
78#
79# go go go!
80#
81
82&log(sprintf "going to %sfetch %d days%s of data into %s (%s)",
83        (defined $opt->{gaps_file} ? "micro-gap " : ""),
84        $opt->{days},
85        ($opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
86        $opt->{outputfile},
87        ($opt->{fast} ? "with haste" : "slowly"));
88
89# read channels file
90if (-r $opt->{channels_file}) {
91        local (@ARGV, $/) = ($opt->{channels_file});
92        no warnings 'all'; eval <>; die "$@" if $@;
93} else {
94        die "WARNING: channels file $opt->{channels_file} could not be read: $!\n";
95}
96
97die "Nothing to do! Channel NSW not defined in $opt->{channels_file}\n"
98  unless (defined $channels->{'Channel NSW'});
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 Channel NSW in gaps lineup, nothing to do!\n"
109          unless ((defined $gaps) && (defined $gaps->{'Channel NSW'}));
110}
111
112&get_data;
113&insert_stop_times;
114&fill_first_day;
115&write_data;
116&print_stats;
117exit(0);
118
119######################################################################################################
120# help
121
122sub help
123{
124        print<<EOF
125$progname $version
126
127Command-line options:
128  --help                Display this page
129  --days=n              Try to fetch up to n days of data (default: $opt->{days})
130  --output=file         Write XML output to file (default: "$opt->{outputfile}")
131  --fast                Download data ASAP (not recommended: impolite)
132  --debug               Display debugging messages
133  --no-retry            Don't retry on network failure
134  --lang=[s]            Set language in output data (default $opt->{lang})
135  --channels_file=file  Specify where to read channels data from
136  --gaps_file=file      Specify where to read gaps data from
137
138EOF
139;
140
141        exit(0);
142}
143
144######################################################################################################
145
146sub get_data
147{
148        # 7 days in one URL
149        my ($data, $success, $status, $bytes, $slept_for, $failed_attempts) = 
150            Shepherd::Common::get_url( url => $GUIDE, fake => 0 );
151        die "Download failed: $status" unless ($success);
152
153        #
154        # set up @day_range and %day_range_names
155        #
156        my $t = time;
157        my @today = localtime($t); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
158        # set zerohr to midnight on day 0
159        $zerohr = $t - (($today[0]) + ($today[1]*60) + ($today[2]*60*60));
160        my @day_range;
161        my %day_range_names = (sunday=>0,monday=>1,tuesday=>2,wednesday=>3,thursday=>4,friday=>5,saturday=>6);
162        foreach my $daynum (0..6) {
163                my $d = ($today[6] + $daynum) % 7;
164                $day_range[$d] = $zerohr + ($daynum * (60*60*24));
165                &log((sprintf "calculated day %d wkdaynum %d epoch to %d",
166                        $daynum, $d, $day_range[$d])) if $opt->{debug};
167        }
168
169        my $tree = HTML::TreeBuilder->new_from_content($data);
170
171        my @seen_day_tag, my @column_is_day, my @column_maps_to_time;
172        my @time_column_wrapped_over_midnight;
173        my @prev_row_prog_tag;
174
175        my $seen_time_tag_column = -1;
176        &log("state machine is 0, looking for start of table") if $opt->{debug};
177
178        my @tables =  $tree->look_down('_tag' => 'table');
179
180        # Guide data is in tables # 10-16 (one per day, starting with Sunday)
181        my $table_offset = 10;
182        for (my $i = $table_offset; $i <= $table_offset + 6; $i++)
183        {
184            foreach my $tr ($tables[$i]->look_down('_tag' => 'tr')) 
185            {
186                my $prog;
187                $prog->{channel} = $channels->{'Channel NSW'};
188                $prog->{daynum} = ($i - $table_offset - $today[6]) % 7;
189
190                my ($timetag, $nametag) = $tr->look_down('_tag' => 'td');
191
192                # Set name
193                my $name = $nametag->as_text();
194                $prog->{'previously-shown'} = { } if ($name =~ /\(Rpt\)/);
195                # Anything in brackets isn't part of title
196                $name =~ s/ ?\(.*?\)//g;
197                $prog->{title} = [[ $name, $opt->{lang} ]];
198
199                # Set link to details
200                my $atag = $nametag->look_down('_tag' => 'a');
201                $prog->{url} = [ $DATASOURCE . '/' . $atag->attr('href') ];
202
203                # Set the time
204                my $time;
205                if ($timetag->as_HTML() =~ /<span>(\d+):(\d+) ([ap]m):&nbsp;/)
206                {
207                    $time = $1;
208                    $time = 0 if ($time == 12);
209                    $time += 12 if ($3 eq 'pm');
210                    $time = ($time * 60 * 60) + ($2 * 60); # in seconds past midnight
211
212                    $time += $day_range[$i - $table_offset];
213
214                    $prog->{starttime} = $time;
215                }
216                else
217                {
218                    die "Couldn't parse time tag: " . $timetag->as_HTML . "\n";
219                }
220
221                $tv_guide->{($prog->{starttime})} = $prog;
222
223                if ($opt->{debug})
224                {
225                    print localtime($time) . ": $name\n";
226#                   print Dumper($prog);
227                }
228            }
229        }
230        $tree->delete;
231}
232
233######################################################################################################
234#
235# Insert stop times
236#
237
238sub insert_stop_times
239{
240    my $stoptime;
241    foreach my $starttime (reverse sort keys %$tv_guide)
242    {
243        my $prog = $tv_guide->{$starttime};
244
245        # Little hack for the last program of each day: assume it runs for 2hrs
246        # (because it's always "Late night Languages", which does)
247        unless (defined $stoptime)
248        {
249            $stoptime = $starttime + (2 * 60 * 60);
250        }
251        $tv_guide->{$starttime}->{stoptime} = $stoptime;
252        $stoptime = $starttime;
253    }
254}
255
256# Copy the last program on day 6 to the start of day 0. Otherwise
257# we have a hole on day 0 until the first program starts (at
258# 12:30am).
259sub fill_first_day
260{
261    my $lastprog = (reverse sort keys %$tv_guide)[0];
262    my %h = %{$tv_guide->{$lastprog}};
263    $h{stoptime} -= (7 * 86400);
264    $h{starttime} -= (7 * 86400);
265    $tv_guide->{$h{starttime}} = \%h;
266}
267
268######################################################################################################
269#
270#
271
272sub log
273{
274        my ($entry) = @_;
275        printf "%s\n",$entry;
276}
277
278######################################################################################################
279
280sub nice_time
281{
282        my $t = shift;
283        return POSIX::strftime("%Y%m%d%H%M",localtime($t));
284}
285
286######################################################################################################
287
288sub print_stats
289{
290        printf "STATS: %s v%s completed in %d seconds",$progname, $version, (time-$script_start_time);
291        foreach my $key (sort keys %stats) {
292                printf ", %d %s",$stats{$key},$key;
293        }
294        printf "\n";
295}
296
297######################################################################################################
298
299sub write_data
300{
301        my $writer;
302
303        my %writer_args = ( encoding => 'ISO-8859-1' );
304        my $fh = new IO::File(">$opt->{outputfile}") || die "can't open $opt->{outputfile}: $!";
305        $writer_args{OUTPUT} = $fh;
306
307        $writer = new XMLTV::Writer(%writer_args);
308
309        $writer->start
310          ( { 'source-info-name'   => "$progname $version",
311              'generator-info-name' => "$progname $version"} );
312
313        $writer->write_channel( {
314                'display-name' => [[ 'Channel NSW', $opt->{lang} ]],
315                'id' => $channels->{'Channel NSW'} } );
316
317        foreach my $prog (sort keys %$tv_guide) {
318                if ($tv_guide->{$prog}->{stoptime} >= ($zerohr + ($opt->{offset} * 86400)) and
319                    ($tv_guide->{$prog}->{starttime} < ($zerohr + ($opt->{days} * 86400)))) {
320
321                        # if we are fetching microgaps, skip if this isn't
322                        # in a micro-gap
323                        if (defined $opt->{gaps_file}) {
324                                my $found_gap_match = 0;
325                                foreach my $g (@{($gaps->{'Channel NSW'})}) {
326                                        my ($s, $e) = split(/-/,$g);
327
328                                        $found_gap_match = 1 if
329                                           ((($s >= $tv_guide->{$prog}->{starttime}) &&
330                                             ($s <= $tv_guide->{$prog}->{stoptime})) ||
331                                            (($e >= $tv_guide->{$prog}->{starttime}) &&
332                                             ($e <= $tv_guide->{$prog}->{stoptime})) ||
333                                            (($s <= $tv_guide->{$prog}->{starttime}) &&
334                                             ($e >= $tv_guide->{$prog}->{stoptime})));
335                                }
336                                if (!$found_gap_match) {
337                                        $stats{gaps_skipped}++;
338                                        next;
339                                } else {
340                                        $stats{gaps_included}++;
341                                }
342                        }
343
344                        $tv_guide->{$prog}->{start} = &nice_time($tv_guide->{$prog}->{starttime});
345                        $tv_guide->{$prog}->{stop} = &nice_time($tv_guide->{$prog}->{stoptime});
346                        delete $tv_guide->{$prog}->{daynum};
347                        delete $tv_guide->{$prog}->{starttime};
348                        delete $tv_guide->{$prog}->{stoptime};
349                        &Shepherd::Common::cleanup($tv_guide->{$prog});
350
351                        $writer->write_programme($tv_guide->{$prog});
352                        $stats{progs}++;
353                }
354        }
355
356        $writer->end();
357}
358
359######################################################################################################
Note: See TracBrowser for help on using the browser.