Context Navigation

sbsnews_website

Revision 1129, 15.1 kB (checked in by paul, 4 years ago)
sbsnews_website: handle time slot with no name
Property svn:executable set to ``*

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
16	use strict;
17
18	my $progname = "sbsnews_website";
19	my $version = "1.02";
20
21	use XMLTV;
22	use POSIX qw(strftime);
23	use Getopt::Long;
24	use HTML::TreeBuilder;
25	use Shepherd::Common;
26	#use Data::Dumper::Simple;
27
28	#
29	# some initial cruft
30	#
31
32	my $script_start_time = time;
33	my %stats;
34	my $channels, my $opt_channels, my $gaps;
35
36	$\| = 1;
37
38	#
39	# parse command line
40	#
41
42	my $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
50	GetOptions(
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
69	if ($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
75	die "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
88	if (-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
97	die "no SBSNEWS channel found in channel lineup from $opt->{channels_file}\n"
98	unless (defined $channels->{'SBS News'});
99
100	if (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
112	my $week = &get_sbsnews_data();
113	$week = &fix_gaps($week);
114	&write_data($week);
115	&print_stats;
116	exit(0);
117
118	######################################################################################################
119	# help
120
121	sub help
122	{
123	print<<EOF
124	$progname $version
125
126	options 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
135	EOF
136	;
137
138	exit(0);
139	}
140
141	######################################################################################################
142
143	sub log
144	{
145	my ($entry) = @_;
146	printf "%s\n",$entry;
147	}
148
149	######################################################################################################
150
151	sub print_time
152	{
153	my $t = shift;
154	return sprintf "%02d:%02d",$t/(60*60),$t/60%60;
155	}
156
157	######################################################################################################
158
159	sub nice_time
160	{
161	my $t = shift;
162	return POSIX::strftime("%Y%m%d%H%M",localtime($t));
163	}
164
165	######################################################################################################
166
167	sub 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
178	sub 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 = ($16060)+($2*60);
203	$seen_24_time = 1 if $1 >= 13;
204	$start_time += (126060) 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 += (126060);
210	} else {
211	$next_12hours_start = 0;
212	$start_time -= (126060);
213	}
214	}
215	if ($start_time >= (246060)) {
216	$next_12hours_start = 0;
217	$start_time -= (246060);
218	}
219	}
220
221	if ($3 && $4) {
222	$stop_time = ($36060)+($4*60);
223	$seen_24_time = 1 if $3 >= 13;
224	$stop_time += (126060) 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 += (126060);
230	} else {
231	$next_12hours_stop = 0;
232	$stop_time -= (126060);
233	}
234	}
235	if ($stop_time >= (246060)) {
236	$next_12hours_stop = 0;
237	$stop_time -= (246060);
238	}
239	}
240	} else {
241	$stop_time = $start_time;
242	}
243
244	if ($start_time > $stop_time) {
245	$stop_time += (246060);
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; #   can be   ==
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
292	sub 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
353	sub 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] + (246060);
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 >= (246060)) {
379	$new_stop -= (246060);
380	$prev_start -= (246060);
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 >= (246060)) {
403	$stop -= (246060);
404	$prev_start -= (246060);
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 % (246060)) <= (76060))) {
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 += (246060);
449	}
450	return $week;
451	}
452
453	######################################################################################################
454
455	sub 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} > (246060)) {
490	$last_prog->{start} = $last_prog->{start} - (246060);
491	$last_prog->{stop} = $last_prog->{stop} - (246060);
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(2460*60) + $week->{$day}->{$start}->{start};
500	my $stop_time = $currday + $offset(2460*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 browser.

Context Navigation

root/trunk/grabbers/sbsnews_website

Download in other formats: