Context Navigation

sbsnews_website @ 634

Revision 634, 18.7 kB (checked in by max, 6 years ago)
Fill in 6am Monday hole in sbsnews_website
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
11	# changelog:
12	# 0.01 24oct06 initial release
13
14	use strict;
15
16	my $progname = "sbsnews_website";
17	my $version = "0.12";
18
19	use LWP::UserAgent;
20	use XMLTV;
21	use POSIX qw(strftime);
22	use Getopt::Long;
23	use Data::Dumper;
24	use HTML::TreeBuilder;
25
26	#
27	# some initial cruft
28	#
29
30	my $script_start_time = time;
31	my %stats;
32	my $channels, my $opt_channels, my $gaps;
33	my $tv_guide;
34
35	my $ua;
36	$ua = LWP::UserAgent->new('timeout' => 30, 'keep_alive' => 30, 'agent' => "Shepherd / $progname $version");
37	$ua->env_proxy;
38	# $ua->cookie_jar({});
39	$\| = 1;
40
41	#
42	# parse command line
43	#
44
45	my $opt;
46	$opt->{days} = 7; # default
47	$opt->{offset} = 0; # default
48	$opt->{outputfile} = "output.xmltv"; # default
49	$opt->{channels_file} = ""; # mandatory for user to specify
50	$opt->{debug} = 0; # default
51	$opt->{lang} = "en"; # default
52
53	GetOptions(
54	'region=i' => \$opt->{region}, # ignored
55	'timezone=s' => \$opt->{timezone}, # ignored
56	'config-file=s' => \$opt->{configfile}, # ignored
57	'days=i' => \$opt->{days},
58	'offset=i' => \$opt->{offset},
59	'channels_file=s' => \$opt->{channels_file},
60	'gaps_file=s' => \$opt->{gaps_file},
61	'output=s' => \$opt->{outputfile},
62	'fast' => \$opt->{fast},
63	'debug+' => \$opt->{debug},
64	'lang=s' => \$opt->{lang},
65	'no-retry' => \$opt->{dont_retry},
66	'help' => \$opt->{help},
67	'verbose' => \$opt->{help},
68	'version' => \$opt->{version},
69	'ready' => \$opt->{version},
70	'v' => \$opt->{help});
71
72	&help if ($opt->{help});
73
74	if ($opt->{version}) {
75	printf "%s %s\n",$progname,$version;
76	printf "Collects news lineup for SBSNEWS from SBS Web site." if $opt->{desc};
77	exit(0);
78	}
79
80	die "no channel file specified, see --help for instructions\n", if ($opt->{channels_file} eq "");
81
82	#
83	# go go go!
84	#
85
86	# normalize starttime to an hour..
87	my $starttime = time;
88	my $endtime = $starttime + ($opt->{days} * 86400);
89	$starttime += (86400 * $opt->{offset});
90
91	&log(sprintf "going to %sfetch %d days%s of data into %s (%s)",
92	(defined $opt->{gaps_file} ? "micro-gap " : ""),
93	$opt->{days},
94	($opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
95	$opt->{outputfile},
96	($opt->{fast} ? "with haste" : "slowly"));
97
98	# read channels file
99	if (-r $opt->{channels_file}) {
100	local (@ARGV, $/) = ($opt->{channels_file});
101	no warnings 'all'; eval <>; die "$@" if $@;
102	} else {
103	die "WARNING: channels file $opt->{channels_file} could not be read: $!\n";
104	}
105
106	# unless we have SBSNEWS defined as a channel, nothing to do!
107
108	die "no SBSNEWS channel found in channel lineup from $opt->{channels_file}\n"
109	unless (defined $channels->{'SBS News'});
110
111	if (defined $opt->{gaps_file}) {
112	if (-r $opt->{gaps_file}) {
113	local (@ARGV, $/) = ($opt->{gaps_file});
114	no warnings 'all'; eval <>; die "$@" if $@;
115	} else {
116	die "WARNING: gaps file $opt->{gaps_file} could not be read: $!\n";
117	}
118
119	die "no SBSNEWS channel in gaps lineup, nothing to do!\n"
120	unless ((defined $gaps) && (defined $gaps->{'SBS News'}));
121	}
122
123	&get_sbsnews_data($starttime,$endtime);
124	&adjust_stop_times;
125	&write_data;
126	&print_stats;
127	exit(0);
128
129	######################################################################################################
130	# help
131
132	sub help
133	{
134	print<<EOF
135	$progname $version
136
137	options are as follows:
138	--help show these help options
139	--days=N fetch 'n' days of data (default: $opt->{days})
140	--output=file send xml output to file (default: "$opt->{outputfile}")
141	--fast don't run slow - get data as quick as you can - not recommended
142	--debug increase debug level
143	--no-retry if webserver is rejecting our request, don't retry (default: do retry)
144	--lang=[s] set language of xmltv output data (default $opt->{lang})
145	--channels_file=file where to get channel data from
146	--gaps_file=file micro-fetch gaps only
147
148	EOF
149	;
150
151	exit(0);
152	}
153
154	######################################################################################################
155
156	sub get_sbsnews_data
157	{
158	my ($starttime,$endtime) = @_;
159
160	# 7 days in one URL: http://www.sbs.com.au/whatson/WNC-Schedule.html
161	my $data = &get_url("http://www.sbs.com.au/whatson/WNC-Schedule.html","weekly summary data",5);
162	die "no data returned from web server! failed.\n" unless ($data);
163
164	#
165	# set up @day_range and %day_range_names
166	#
167	my $currtime = time;
168	my @today = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
169	# set currtime back to match midnight.
170	$currtime -= (($today[0]) + ($today[1]60) + ($today[2]60*60));
171	my @day_range;
172	my %day_range_names = (sunday=>0,monday=>1,tuesday=>2,wednesday=>3,thursday=>4,friday=>5,saturday=>6);
173	foreach my $daynum (0..6) {
174	my $d = ($today[6] + $daynum) % 7;
175	$day_range[$d] = $currtime + ($daynum * (606024));
176	&log((sprintf "calculated day %d wkdaynum %d epoch to %d",$daynum,$d,$day_range[$d])) if $opt->{debug};
177	}
178
179	#
180	# parse html using the following state machine:
181	# 0 = looking for first time tag
182	# 1 = got first time tag
183	# 2 = reading programmes
184	# 3 = end of programmes
185	#
186	my $state_machine = 0;
187	my @time_column;
188	my $tree = HTML::TreeBuilder->new_from_content($data);
189	my $time_tag_count = 0;
190	my $tr_count = 0;
191
192	my @seen_day_tag, my @column_is_day, my @column_maps_to_time;
193	my @time_column_wrapped_over_midnight;
194	my @prev_row_prog_tag;
195
196	my $seen_time_tag_column = -1;
197	&log("state machine is 0, looking for start of table") if $opt->{debug};
198
199	foreach my $tr1 ($tree->look_down('_tag' => 'tr')) {
200	my $td_count = 0;
201	my @row;
202
203	foreach my $td1 ($tr1->look_down('_tag' => 'td')) {
204	if ($td1->as_text() =~ /^Time$/) {
205	if ($state_machine < 2) {
206	&log("found time tag $time_tag_count in column $td_count") if $opt->{debug};
207	$time_column[$time_tag_count] = $td_count;
208	$seen_time_tag_column = $time_tag_count;
209	if ($time_tag_count == 0) {
210	$state_machine = 1;
211	&log("advanced state machine to 1, looking for day names") if $opt->{debug};
212	}
213
214	# if this is a new time tag & we have existing unprocessed
215	# columns, fix em up now
216	for my $col (0..($#column_maps_to_time)) {
217	if ((defined $column_maps_to_time[$col]) &&
218	($column_maps_to_time[$col] == -1)) {
219	$column_maps_to_time[$col] = $td_count;
220	&log("fixed up column $col to map to time in column $td_count") if $opt->{debug};
221	}
222	}
223	$time_tag_count++;
224	} else {
225	$state_machine = 3;
226	}
227	} elsif ($td1->as_text() =~ /^\S$/) {
228	if ($state_machine == 1) {
229	$time_tag_count++;
230	&log("blank column in $td_count, incremented time_tag to $time_tag_count") if $opt->{debug};
231
232	# blank column clears out our time column
233	$seen_time_tag_column = -1;
234	}
235	} else {
236	next if ($state_machine == 0);
237
238	# parse day name
239	if (($state_machine == 1) && ($td1->as_text() =~ /day$/)) {
240	# got a day name..
241	my $dname = lc($td1->as_text());
242	if (defined $day_range_names{$dname}) {
243	my $dnum = $day_range_names{$dname};
244	die "saw day tag for $dname more than once. has the HTML format changed?"
245	if (defined $seen_day_tag[$dnum]);
246	$seen_day_tag[$dnum]++;
247	$column_is_day[$td_count] = $dnum;
248	$column_maps_to_time[$td_count] = $seen_time_tag_column;
249	&log("column $td_count is day $dnum ($dname) epoch $day_range[$dnum] time column $seen_time_tag_column")
250	if $opt->{debug};
251	} else {
252	die "expected day name, got '$dname'. has the HTML format changed?";
253	}
254	} elsif ($state_machine == 2) {
255	# soak up the data!
256	$row[$td_count] = $td1->as_text();
257	$row[$td_count] =~ s/(^\s+\|\s+$)//g;
258	&log((sprintf "stored row data %d: '%s'", $td_count, $td1->as_text())) if $opt->{debug};
259	} else {
260	&log((sprintf "got other text: state_machine=%d, td_count=%d, got: '%s'",
261	$state_machine,$td_count,$td1->as_text())) if $opt->{debug};
262	}
263	}
264	$td_count++;
265	}
266	if ($state_machine == 1) {
267	$state_machine = 2;
268	&log("advanced state machine to 2, now looking for programmes") if $opt->{debug};
269	next;
270	} elsif ($state_machine == 2) {
271	# process row
272	# 1. loop through $time_column ...
273	foreach my $tcount (0..($time_tag_count-1)) {
274	next if (!defined $time_column[$tcount]);
275	my $tcol = $time_column[$tcount];
276	next if (!defined $row[$tcol]);
277
278	# parse time from $row[$tcol] ... format is "13:30-13:50"
279	my $start_time = -1, my $stop_time = -1;
280	if ($row[$tcol] =~ /^(\d{1,2}):(\d{1,2})\s\-\s(\d{1,2}):(\d{1,2})$/) {
281	$start_time = ($16060)+($2*60);
282	$stop_time = ($36060)+($4*60);
283	} else {
284	&log("couldn't match start/stop time from '".$row[$tcol]."' in column $tcol") if $opt->{debug};
285	}
286
287	# sometimes-subtitle-line (but not always)
288	# if previous line had a programme in this slot and can't match a time,
289	# use this row data as a sub-title for the programme
290	if (($start_time == -1) \|\| ($stop_time == -1)) {
291	foreach my $col (0..$td_count) {
292	if ((defined $column_is_day[$col]) &&
293	(defined $column_maps_to_time[$col]) &&
294	($column_maps_to_time[$col] == $tcol) &&
295	(defined $prev_row_prog_tag[$col])) {
296	if ($row[$col] ne "") {
297	&log("added subtitle '".$row[$col]."' from col $col to previous-row prog '".
298	$tv_guide->{$prev_row_prog_tag[$col]}->{title}->[0]->[0]."'") if $opt->{debug};
299
300	$tv_guide->{$prev_row_prog_tag[$col]}->{'sub-title'} = [[ $row[$col], $opt->{lang} ]];
301	}
302	$prev_row_prog_tag[$col] = undef;
303	}
304	}
305	next;
306	}
307
308	# apply midnight-wrapping if seen a previous wrap-over-midnight
309	if (defined $time_column_wrapped_over_midnight[$tcol]) {
310	&log("applying add-on-24-hours because of previous wrap around midnight") if $opt->{debug};
311	$start_time += (606024);
312	$stop_time += (606024);
313	}
314
315	# wrapping over midnight for the first time
316	if ($stop_time < $start_time) {
317	$time_column_wrapped_over_midnight[$tcol] = 1;
318	$stop_time += (606024);
319	&log("detected wrap-around-midnight for time '$row[$tcol]' in column $tcol") if $opt->{debug};
320	}
321
322	# loop through all programmes which match this time column
323	foreach my $col (0..$td_count) {
324	if ((defined $column_is_day[$col]) &&
325	(defined $column_maps_to_time[$col]) &&
326	($column_maps_to_time[$col] == $tcol)) {
327	next if ($row[$col] eq "");
328
329	my $prog;
330	$prog->{channel} = $channels->{'SBS News'};
331	$prog->{title} = [[ $row[$col], $opt->{lang} ]];
332	$prog->{starttime} = $start_time + $day_range[($column_is_day[$col])];
333	$prog->{stoptime} = $stop_time + $day_range[($column_is_day[$col])];
334
335	$prog->{category} = [[ 'News', undef ]] if ($progname =~ /News/i);
336	$prog->{daynum} = ($day_range[($column_is_day[$col])] - $currtime) / (606024);
337
338	$tv_guide->{($prog->{starttime})} = $prog;
339	$prev_row_prog_tag[$col] = $prog->{starttime};
340
341	&log((sprintf "got prog col %d: start=%d (%s), stop=%d (%s), '%s', day=%d",
342	$col,$start_time,$prog->{starttime},$stop_time,$prog->{stoptime},$row[$col],$column_is_day[$col]))
343	if $opt->{debug};
344
345	$stats{seen_progs}++;
346	}
347	}
348	}
349	}
350	$tr_count++;
351	&log("advanced tr_count to $tr_count") if $opt->{debug};
352	}
353	die "didn't find 'time' tag in HTML table. has the HTML format changed?"
354	if ($state_machine == 0);
355
356	die "didn't find any programmes! has the HTML format changed?"
357	if ($stats{seen_progs} == 0);
358	}
359
360	######################################################################################################
361
362	# sbsnews data from http://www.sbs.com.au/whatson/WNC-Schedule.html has 5 or 10
363	# minute holes in it. this fills in those holes by extending programs over holes.
364	# it also adds in "Station Close" programs for long overnight gaps.
365
366	sub adjust_stop_times
367	{
368	my $prev_start;
369
370	&log("Extending stop times to fill in small guide data holes.");
371	# reverse-sort thru list to adjust prog stop times
372	foreach my $prog (sort {$b cmp $a} keys %$tv_guide) {
373	if ($prev_start and $tv_guide->{$prog}->{stoptime} ne $prev_start) {
374	my $diff = $prev_start - $tv_guide->{$prog}->{stoptime};
375
376	# Gaps of 50+ minutes before 7am are Station Closes
377	if ($diff / 60 > 50 and ((localtime($prev_start))[2] < 7)) {
378	my $last_stop = $tv_guide->{$prog}->{stoptime};
379	my $newprog = { title => [[ 'Station Close', $opt->{lang} ]],
380	channel => $channels->{'SBS News'},
381	starttime => $last_stop,
382	stoptime => $prev_start,
383	daynum => $tv_guide->{$prog}->{daynum} };
384	&log(sprintf "Inserting Station Close: %s to %s.",
385	&nice_time($newprog->{starttime}),
386	&nice_time($newprog->{stoptime}));
387	$tv_guide->{$last_stop} = $newprog;
388
389	# Gaps of 15+ minutes in other times are genuine holes
390	# If the gap is a weekday, fill it with whatever was in
391	# that timeslot tommorow (we have Monday holes for some reason)
392	} elsif ($diff / 60 > 15) {
393	my $wday = (localtime($prev_start))[6];
394	if ($wday > 0 and $wday < 5 and $tv_guide->{$prog + 86400}) {
395	my $hole_start = $tv_guide->{$prog}->{stoptime};
396	my $newprog = { %{$tv_guide->{$hole_start + 86400}}};
397	$newprog->{starttime} -= 86400;
398	$newprog->{stoptime} -= 86400;
399	my $last_stop = $tv_guide->{$prog}->{stoptime};
400	&log(sprintf "Filling weekday gap (%s) with next day's schedule (\"%s\").",
401	&nice_time($hole_start), $newprog->{title}[0][0]);
402	$tv_guide->{$last_stop} = $newprog;
403	} else {
404	&log(sprintf "Not extending stop time of \"%s\": gap too large (%d mins) (ends at %s)",
405	$tv_guide->{$prog}->{title}[0][0],
406	$diff/60,
407	&nice_time($tv_guide->{$prog}->{stoptime}));
408	}
409
410	# Gaps of <15 minutes shall be filled in
411	} else {
412	&log(sprintf "Extending stop time of \"%s\" by %d mins (from %s to %s).",
413	$tv_guide->{$prog}->{title}[0][0],
414	($prev_start - $tv_guide->{$prog}->{stoptime})/60,
415	&nice_time($tv_guide->{$prog}->{stoptime}),
416	&nice_time($prev_start)) if ($opt->{debug});
417	$tv_guide->{$prog}->{stoptime} = $prev_start;
418	}
419	}
420	$prev_start = $tv_guide->{$prog}->{starttime};
421	}
422	}
423
424	######################################################################################################
425
426	# logic to fetch a page via http
427	# retries up to 3 times to get a page with 5 second pauses inbetween
428
429	sub get_url
430	{
431	my ($url,$status,$retrycount) = @_;
432	my $response;
433	my $attempts = 0;
434	my ($raw, $page, $base);
435
436	$retrycount = 8 if ($retrycount == 0);
437	my $request = HTTP::Request->new(GET => $url);
438	$request->header('Accept-Encoding' => 'gzip');
439
440	for (1..$retrycount) {
441	$attempts++;
442	&log("fetching $url, attempt $attempts");
443
444	$response = $ua->request($request);
445	last if ($response->is_success);
446
447	$stats{http_failed_requests}++;
448	$stats{slept_for} += 20;
449	sleep 20;
450	}
451	if (!($response->is_success)) {
452	&log("aborting after $attempts attempts to fetch url $url");
453	return undef;
454	}
455
456	$stats{bytes_fetched} += do {use bytes; length($response->content)};
457	$stats{http_successful_requests}++;
458
459	# if (!$opt->{fast}) {
460	# my $sleeptimer = int(rand(5)) + 1; # sleep anywhere from 1 to 5 seconds
461	# $stats{slept_for} += $sleeptimer;
462	# sleep $sleeptimer;
463	# }
464
465	if ($response->header('Content-Encoding') &&
466	$response->header('Content-Encoding') eq 'gzip') {
467	$stats{compressed_pages} += do {use bytes; length($response->content)};
468	$response->content(Compress::Zlib::memGunzip($response->content));
469	}
470	return $response->content;
471	}
472
473	######################################################################################################
474
475	sub log
476	{
477	my ($entry) = @_;
478	printf "%s\n",$entry;
479	}
480
481	######################################################################################################
482
483	sub nice_time
484	{
485	my $t = shift;
486	return POSIX::strftime("%Y%m%d%H%M",localtime($t));
487	}
488
489	######################################################################################################
490
491	sub print_stats
492	{
493	printf "STATS: %s v%s completed in %d seconds",$progname, $version, (time-$script_start_time);
494	foreach my $key (sort keys %stats) {
495	printf ", %d %s",$stats{$key},$key;
496	}
497	printf "\n";
498	}
499
500	######################################################################################################
501	# descend a structure and clean up various things, including stripping
502	# leading/trailing spaces in strings, translations of html stuff etc
503	# -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
504
505	my %amp;
506	BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
507
508	sub cleanup {
509	my $x = shift;
510	if (ref $x eq "REF") { cleanup($_) }
511	elsif (ref $x eq "HASH") { cleanup(\$_) for values %$x }
512	elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
513	elsif (defined $$x) {
514	$$x =~ s/&(#(\d+)\|(.*?));/ $2 ? chr($2) : $amp{$3}\|\|' ' /eg;
515	$$x =~ s/[^\x20-\x7f]//g;
516	$$x =~ s/(^\s+\|\s+$)//g;
517	}
518	}
519
520	######################################################################################################
521
522	sub write_data
523	{
524	my $writer;
525
526	my %writer_args = ( encoding => 'ISO-8859-1' );
527	my $fh = new IO::File(">$opt->{outputfile}") \|\| die "can't open $opt->{outputfile}: $!";
528	$writer_args{OUTPUT} = $fh;
529
530	$writer = new XMLTV::Writer(%writer_args);
531
532	$writer->start
533	( { 'source-info-name' => "$progname $version",
534	'generator-info-name' => "$progname $version"} );
535
536	$writer->write_channel( {
537	'display-name' => [[ 'SBS News', $opt->{lang} ]],
538	'id' => $channels->{'SBS News'} } );
539
540	foreach my $prog (sort keys %$tv_guide) {
541	if (($tv_guide->{$prog}->{daynum} >= $opt->{offset}) &&
542	($tv_guide->{$prog}->{daynum} < $opt->{days})) {
543
544	# if we are fetching microgaps, skip if this isn't
545	# in a micro-gap
546	if (defined $opt->{gaps_file}) {
547	my $found_gap_match = 0;
548	foreach my $g (@{($gaps->{'SBS News'})}) {
549	my ($s, $e) = split(/-/,$g);
550
551	$found_gap_match = 1 if
552	((($s >= $tv_guide->{$prog}->{starttime}) &&
553	($s <= $tv_guide->{$prog}->{stoptime})) \|\|
554	(($e >= $tv_guide->{$prog}->{starttime}) &&
555	($e <= $tv_guide->{$prog}->{stoptime})) \|\|
556	(($s <= $tv_guide->{$prog}->{starttime}) &&
557	($e >= $tv_guide->{$prog}->{stoptime})));
558	}
559	if (!$found_gap_match) {
560	$stats{gaps_skipped}++;
561	next;
562	} else {
563	$stats{gaps_included}++;
564	}
565	}
566
567	$tv_guide->{$prog}->{start} = &nice_time($tv_guide->{$prog}->{starttime});
568	$tv_guide->{$prog}->{stop} = &nice_time($tv_guide->{$prog}->{stoptime});
569	delete $tv_guide->{$prog}->{daynum};
570	delete $tv_guide->{$prog}->{starttime};
571	delete $tv_guide->{$prog}->{stoptime};
572	&cleanup($tv_guide->{$prog});
573
574	$writer->write_programme($tv_guide->{$prog});
575	$stats{progs}++;
576	}
577	}
578
579	$writer->end();
580	}
581
582	######################################################################################################

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/sbsnews_website @ 634

Download in other formats: