Context Navigation

abc_website @ 299

Revision 299, 19.3 kB (checked in by lincoln, 6 years ago)
quieten warnings when there have been no cache entries used
Property svn:executable set to ``*

Line
1	#!/usr/bin/perl -w
2
3	# abc_website au_tv guide grabber - runs from "Shepherd" master grabber
4	# * written by ltd
5	# * uses ABC website for ABC data ((http://www.abc.net.au/tv/guide/)
6	# * when used in conjunction with Shepherd, shepherd can collect other channels
7	# using other grabbers
8	# * this does NOT use any config file - all settings are passed in from shepherd
9
10	# changelog:
11	# 1.50 22sep06 added support for "shepherd" master grabber script
12	# 1.51 02oct06 --ready option
13	# 1.52 03oct06 split out abc grabber into its own grabber
14	# 1.55 09oct06 formalize --cheap option
15	# 1.56 20oct06 misc cleanups
16	# 1.60 11nov06 fix midday time calculation
17	# 1.70 16nov06 also use "printable" TV guide to determine 'station close'
18	# 2.00 23nov06 simplified
19
20	use strict;
21
22	my $progname = "abc_website";
23	my $version = "2.02";
24
25	use LWP::UserAgent;
26	use Time::HiRes qw(gettimeofday tv_interval);
27	use XMLTV;
28	use POSIX qw(strftime mktime);
29	use Getopt::Long;
30	use HTML::TreeBuilder;
31	use Data::Dumper;
32	use Cwd;
33
34	#
35	# some initial cruft
36	#
37
38	my $script_start_time = [gettimeofday];
39	my %stats;
40	my $channels, my $opt_channels;
41	my $tv_guide;
42	my $data_cache;
43	my @station_close_data;
44	my $writer;
45
46	my $ua;
47	$ua = LWP::UserAgent->new('timeout' => 30, 'keep_alive' => 30, 'agent' => "Shepherd / $progname $version");
48	$ua->env_proxy;
49	# $ua->cookie_jar({});
50	$ua->conn_cache(LWP::ConnCache->new());
51	$\| = 1;
52
53	#
54	# parse command line
55	#
56
57	my $opt_days = 7; # default
58	my $opt_offset = 0; # default
59	my $opt_timezone = "1000"; # default
60	my $opt_outputfile = cwd() . "/abc_website.xmltv"; # default
61	my $opt_configfile = cwd() . "/abc_website.conf"; # ignored
62	my $opt_cache_file = cwd() . "/abc_website.cache"; # ignored
63	my $opt_channels_file= "";
64	my $opt_no_cache = 0;
65	my $opt_cheap = 0;
66	my $opt_fast = 0;
67	my $opt_warper = 0;
68	my $opt_obfuscate = 0;
69	my $opt_do_extra_days = 0;
70	my $opt_help = 0;
71	my $opt_version = 0;
72	my $opt_desc = 0;
73	my $opt_dont_retry = 0;
74	my $debug = 0;
75	my $lang = "en";
76	my $region = 94;
77	my $time_offset = 0;
78
79	GetOptions(
80	'region=i' => \$region,
81	'days=i' => \$opt_days,
82	'offset=i' => \$opt_offset,
83	'timezone=s' => \$opt_timezone,
84	'channels_file=s' => \$opt_channels_file,
85	'output=s' => \$opt_outputfile,
86	'config-file=s' => \$opt_configfile,
87	'cache-file=s' => \$opt_cache_file,
88	'do-extra-days' => \$opt_do_extra_days,
89	'fast' => \$opt_fast,
90	'no-cache' => \$opt_no_cache,
91	'cheap' => \$opt_cheap,
92	'debug+' => \$debug,
93	'warper' => \$opt_warper,
94	'lang=s' => \$lang,
95	'obfuscate' => \$opt_obfuscate,
96	'no-retry' => \$opt_dont_retry,
97	'help' => \$opt_help,
98	'verbose' => \$opt_help,
99	'version' => \$opt_version,
100	'ready' => \$opt_version,
101	'desc' => \$opt_desc,
102	'v' => \$opt_help);
103
104	&help if ($opt_help);
105
106	if ($opt_version \|\| $opt_desc) {
107	printf "%s %s\n",$progname,$version;
108	printf "%s is a details-aware grabber that collects decent quality data using the ABC website for ABC only.",$progname if $opt_desc;
109	exit(0);
110	}
111
112	die "no channel file specified, see --help for instructions\n", if ($opt_channels_file eq "");
113
114	#
115	# go go go!
116	#
117
118	my $starttime = time;
119
120	&log(sprintf "going to %s %s%d%s days%s of data into %s (%s%s)",
121	($opt_cheap ? "verify (cache-validate)" : "grab"),
122	($opt_do_extra_days ? "somewhere between " : ""),
123	$opt_days,
124	($opt_do_extra_days ? " to 14" : ""),
125	($opt_offset ? " (skipping first $opt_offset days)" : ""),
126	$opt_outputfile,
127	($opt_no_cache ? "without caching" : "with caching"),
128	($opt_warper ? ", anonymously" : ""));
129
130	# read channels file
131	if (-r $opt_channels_file) {
132	local (@ARGV, $/) = ($opt_channels_file);
133	no warnings 'all'; eval <>; die "$@" if $@;
134	} else {
135	die "WARNING: channels file $opt_channels_file could not be read\n";
136	}
137
138	&read_cache if ($opt_no_cache == 0);
139
140	my %writer_args = ( encoding => 'ISO-8859-1' );
141	my $fh = new IO::File(">$opt_outputfile") \|\| die "can't open $opt_outputfile: $!";
142	$writer_args{OUTPUT} = $fh;
143
144	$writer = new XMLTV::Writer(%writer_args);
145	$writer->start( { 'source-info-name' => "$progname $version", 'generator-info-name' => "$progname $version"} );
146	$writer->write_channel( { 'display-name' => [[ 'ABC', $lang ]], 'id' => $channels->{ABC} } );
147
148	&get_station_close($channels->{ABC},"http://www.abc.net.au/tv/guide/abctvweekguide.htm");
149	&get_abc_data($channels->{ABC},"http://www.abc.net.au/tv/guide/netw");
150	&write_cache if ($opt_no_cache == 0);
151
152	$writer->end;
153
154	&print_stats;
155	exit(0);
156
157	######################################################################################################
158	# help
159
160	sub help
161	{
162	print<<EOF
163	$progname $version
164
165	options are as follows:
166	--help show these help options
167	--days=N fetch 'n' days of data (default: $opt_days)
168	--output=file send xml output to file (default: "$opt_outputfile")
169	--config-file=file (ignored - historically used by grabbers not not this one)
170	--no-cache don't use a cache to optimize (reduce) number of web queries
171	--cheap validate contents of cache - fetch summary only, not details
172	--cache-file=file where to store cache (default "$opt_cache_file")
173	--fast don't run slow - get data as quick as you can - not recommended
174	--debug increase debug level
175	--warper fetch data using WebWarper web anonymizer service
176	--obfuscate pretend to be a proxy servicing multiple clients
177	--do-extra-days fetch extra (14 days) from ABC website
178	--no-retry if webserver is rejecting our request, don't retry (default: do retry)
179	--lang=[s] set language of xmltv output data (default $lang)
180
181	--region=N set region for where to collect data from (default: $region)
182	--channels_file=file where to get channel data from (if not set manually)
183	--timezone=HHMM timezone for channel data (default: $opt_timezone)
184	EOF
185	;
186
187	exit(0);
188	}
189
190	######################################################################################################
191	# populate cache
192
193	sub read_cache
194	{
195	if (-r $opt_cache_file) {
196	local (@ARGV, $/) = ($opt_cache_file);
197	no warnings 'all'; eval <>; die "$@" if $@;
198	} else {
199	printf "WARNING: no programme cache $opt_cache_file - have to fetch all details\n";
200
201	# try to write to it - if directory doesn't exist this will then cause an error
202	&write_cache;
203	}
204	}
205
206	######################################################################################################
207	# write out updated cache
208
209	sub write_cache
210	{
211	if (!(open(F,">$opt_cache_file"))) {
212	printf "WARNING: could not write cache file $opt_cache_file: $!\n";
213	printf "Please fix this in order to reduce the number of queries for data!\n";
214	sleep 10;
215	} else {
216	# cleanup old entries from cache
217	for my $cache_key (keys %{$data_cache}) {
218	my ($starttime, $endtime, $channel, $progname) = split(/,/,$cache_key);
219	if ($starttime < (time-86400)) {
220	delete $data_cache->{$cache_key};
221	$stats{removed_items_from_cache}++;
222	}
223	}
224	print F Data::Dumper->Dump([$data_cache], ["data_cache"]);
225	close F;
226	}
227	}
228
229	######################################################################################################
230
231	sub get_abc_data
232	{
233	my ($xmlid,$urlbase) = @_;
234	my $try_to_add_abc_detail;
235	my $unprocessed_programmes = 0;
236	my $stop_fetching = 0;
237	my @unprocessed_progname, my @unprocessed_starttime, my @unprocessed_url;
238
239	my $days_left = $opt_days;
240	my $to_skip = $opt_offset;
241	my $daynum = 0;
242
243	while ($days_left > 0) {
244	my $currtime = $starttime + ($daynum * 86400);
245	$days_left--;
246	$daynum++;
247
248	if ($to_skip > 0) {
249	$to_skip--;
250	next;
251	}
252
253	my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
254	$timeattr[0] = 0; # zero seconds
255
256	my $url = sprintf "%s/%s.htm",$urlbase,(strftime "%Y%m/%Y%m%d",localtime($currtime));
257
258	my $data;
259	my $tree;
260	my $tries = 0;
261	while (($tries < 5) && (!defined $tree)) {
262	$tries++;
263	&log((sprintf "fetching %s summary data: day %d of %d%s",
264	$xmlid, $daynum, $opt_days, ($tries > 1 ? " (try $tries)" : "")));
265	$data = &get_url($url);
266	$tree = HTML::TreeBuilder->new_from_content($data) if ((defined $data) && ($data ne ""));
267
268	if ((!$tree) && ($tries < 5)) {
269	# slow down ..
270	my $waittime = ($tries*20)+int(rand(20));
271	&log("failed to fetch $url, retrying in $waittime secs");
272	sleep($waittime);
273	$stats{slept_for} += $waittime;
274	}
275	}
276	if (!defined $tree) {
277	&log("failed to fetch $url after $tries attempts; skipping");
278	next;
279	}
280
281	my $seen_programmes = 0;
282	my $seen_pm = 0;
283
284	for ($tree->look_down('_tag' => 'div', 'class' => 'scheduleDiv')) {
285	foreach my $tree_tr ($_->look_down('_tag' => 'tr')) {
286	if (my $tree_row = $tree_tr->look_down('_tag' => 'th', 'scope' => 'row')) {
287	if ($tree_row->as_text() =~ /^(\d+):(\d+)(.)m/) {
288	$timeattr[2] = $1; # hour
289	$timeattr[1] = $2; # min
290
291	if ($3 eq "p") {
292	# pm
293	$timeattr[2] += 12 if ($timeattr[2] != 12);
294	$seen_pm = 1;
295	}
296	my $found_time = mktime(@timeattr);
297
298	# handle programmes that are after midnight
299	if (($seen_pm) && ($3 eq "a")) {
300	if ($timeattr[2] == 12) {
301	$found_time += (126060); # 12:xx am
302	} else {
303	$found_time += (246060);
304	}
305	}
306
307	if ($tree_tr->look_down('_tag' => 'td')) {
308	foreach my $prog ($tree_tr->look_down('_tag' => 'a')) {
309	my $programme = $prog->as_text();
310	my $progurl = $prog->attr('href');
311
312	if ($progurl =~ /^\/tv\/guide\//) {
313	printf "day %d time '%s' (%s) prog: %s url: %s\n",
314	$daynum,$tree_row->as_text(),(strftime "%Y%m%d%H%M", localtime($found_time)),
315	$programme,$progurl if $debug;
316
317	$unprocessed_progname[$unprocessed_programmes] = $programme;
318	$unprocessed_starttime[$unprocessed_programmes] = $found_time;
319	$unprocessed_url[$unprocessed_programmes] = "http://www.abc.net.au".$progurl;
320	$unprocessed_programmes++;
321	$seen_programmes++;
322	} else {
323	printf "ignoring prog %s because url %s is not a detail page\n",
324	$programme,$progurl if $debug;
325	}
326	}
327	}
328	}
329	}
330	}
331	}
332
333	if ($seen_programmes > 0) {
334	$stats{abc_daily_pages}++;
335
336	if (defined $station_close_data[$daynum]) {
337	# get station-close time from the previously-fetched "weekly programme guide"
338
339	$unprocessed_progname[$unprocessed_programmes] = "Station Close";
340	$unprocessed_starttime[$unprocessed_programmes] = $station_close_data[$daynum];
341	$unprocessed_url[$unprocessed_programmes] = "";
342	$unprocessed_programmes++;
343	} else {
344	# throw away last programme from each day - we can't use it as
345	# we don't have a 'stop' time for it
346
347	printf "throwing away '%s' (%s) because we won't have a valid stop time\n",
348	$unprocessed_progname[$unprocessed_programmes-1],
349	(strftime "%Y%m%d%H%M", localtime($unprocessed_starttime[$unprocessed_programmes-1]))
350	if $debug;
351	$unprocessed_progname[$unprocessed_programmes-1] = "";
352	}
353	} else {
354	# if we were trying to fetch more than 7 days, stop on first day with no programmes
355	goto STOP_FETCHING if ($daynum > 7);
356	}
357	}
358
359	STOP_FETCHING:
360	# have 'n' days of this channel unprocessed - process it!
361	&log((sprintf "have summary data, now fetching detail pages for up to %d programmes..",$unprocessed_programmes-2));
362
363	for (my $i = 0; $i < ($unprocessed_programmes-1); $i++) {
364	next if ($unprocessed_progname[$i] eq "");
365
366	$stats{programmes}++;
367	my $prog;
368
369	my $cache_key = sprintf "%d,%d,%s,%s", $unprocessed_starttime[$i], $unprocessed_starttime[$i+1], $xmlid, $unprocessed_progname[$i];
370
371	$prog->{'channel'} = $xmlid;
372	$prog->{'start'} = strftime "%Y%m%d%H%M", localtime($unprocessed_starttime[$i]);
373	$prog->{'stop'} = strftime "%Y%m%d%H%M", localtime($unprocessed_starttime[$i+1]);
374	$prog->{'title'} = [[ $unprocessed_progname[$i], $lang ]];
375
376	if (defined $data_cache->{$cache_key}) {
377	$stats{used_cached_data}++;
378	} else {
379	if ((!$opt_cheap) && ($unprocessed_url[$i] ne "")) {
380	$stats{portal_detail_pages}++;
381	&get_one_abc_event($cache_key, $unprocessed_url[$i]);
382
383	if (($stats{portal_detail_pages} % 25) == 1) {
384	&log((sprintf " .. at %s detail page %d of %d (used %d cached entries)",
385	$xmlid, ($i+1), $unprocessed_programmes-2,
386	(defined $stats{used_cached_data} ? $stats{used_cached_data} : 0)));
387
388	if (!$opt_fast) {
389	# slow down ..
390	my $waittime = 3 + int(rand(10));
391	sleep($waittime);
392	$stats{slept_for} += $waittime;
393	}
394	}
395	}
396	}
397
398	if (defined $data_cache->{$cache_key}) {
399	$prog->{'sub-title'} = [[ $data_cache->{$cache_key}->{subtitle}, $lang ]]
400	if $data_cache->{$cache_key}->{subtitle};
401	$prog->{'desc'} = [[ $data_cache->{$cache_key}->{desc}, $lang ]]
402	if $data_cache->{$cache_key}->{desc};
403	$prog->{'category'} = [[ $data_cache->{$cache_key}->{genre}, $lang ]]
404	if $data_cache->{$cache_key}->{genre};
405	}
406
407	&cleanup($prog);
408	$writer->write_programme($prog);
409	}
410	}
411
412	######################################################################################################
413
414	sub get_one_abc_event
415	{
416	my ($cache_key, $url) = @_;
417	my $seen_programme = 0;
418
419	my $tries = 0;
420	my $tree;
421	while (($tries < 5) && (!$tree)) {
422	$tries++;
423	my $data = &get_url($url);
424	$tree = HTML::TreeBuilder->new_from_content($data) if ((defined $data) && ($data ne ""));
425
426	if ((!$tree) && ($tries < 5)) {
427	# slow down ..
428	my $waittime = ($tries*20)+int(rand(20));
429	&log("failed to fetch $url on try $tries, retrying in $waittime secs");
430	sleep($waittime);
431	$stats{slept_for} += $waittime;
432	}
433	}
434	if (!defined $tree) {
435	&log("failed to fetch $url after $tries attempts; skipping");
436	return;
437	}
438
439	if (my $inner_tree = $tree->look_down('_tag' => 'div', 'class' => 'column2')) {
440	my $event_title = undef, my $event_subtitle = undef, my $event_description = undef, my $event_genre = undef;
441
442	if (my $prog_h2 = $inner_tree->look_down('_tag' => 'h2')) {
443	my $full_title = $prog_h2->as_HTML();
444	($event_title,$event_subtitle) = split(/<br>/,$full_title);
445
446	$event_title =~ s/(<[a-zA-Z0-9]+\>)//g; # remove html tags
447	$event_title =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
448
449	if ($event_subtitle) {
450	$event_subtitle =~ s/(<[\/a-zA-Z0-9]+\>)//g; # remove html tags
451	$event_subtitle =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
452	}
453	}
454
455	my $paranum = 0;
456	foreach my $para ($inner_tree->look_down('_tag' => 'p')) {
457	$paranum++;
458
459	if (($paranum > 1) && (!($para->as_text() =~ /^Go to website/)) && (!($para->as_text() =~ /^Send to a Friend/))) {
460	$event_description .= $para->as_text() . "\n";
461
462	if (my $try_genre = $para->look_down('_tag' => 'a')) {
463	$event_genre = $try_genre->as_text();
464	}
465	}
466	}
467
468	$data_cache->{$cache_key}->{subtitle} = $event_subtitle if $event_subtitle;
469	$data_cache->{$cache_key}->{desc} = $event_description if $event_description;
470	$data_cache->{$cache_key}->{genre} = $event_genre if $event_genre;
471
472	$seen_programme++;
473	$stats{added_cached_data}++;
474
475	&write_cache if (($opt_no_cache == 0) &&
476	(($stats{added_cached_data} % 30) == 0)); # incrementally write
477	}
478
479	if ($seen_programme == 0) {
480	printf "WARNING: failed to parse any programme data from '%s' - blocked/rate-limited/format-changed?\n",$url;
481	$stats{failed_to_parse_portal_detail_page}++;
482	}
483	}
484
485	######################################################################################################
486	# logic to fetch a page via http
487
488	sub get_url
489	{
490	my $url = shift;
491	my $response;
492	my $attempts = 0;
493	my ($raw, $page, $base);
494
495	$url =~ s#^http://#http://webwarper.net/ww/# if $opt_warper;
496	my $request = HTTP::Request->new(GET => $url);
497	$request->header('Accept-Encoding' => 'gzip');
498
499	if ($opt_obfuscate) {
500	$ua->agent('Mozilla/5.0 (Windows; U; Windows NT 5.1; en-us');
501	my $randomaddr = sprintf "203.%d.%d.%d",rand(255),rand(255),(rand(254)+1);
502	$request->header('Via' => '1.0 proxy:81 (Squid/2.3.STABLE3)');
503	$request->header('X-Forwarded-For' => $randomaddr);
504	}
505	$response = $ua->request($request);
506	if (!($response->is_success)) {
507	$stats{http_failed_requests}++;
508	return undef;
509	}
510
511	$stats{bytes_fetched} += do {use bytes; length($response->content)};
512	$stats{http_successful_requests}++;
513
514	if ($response->header('Content-Encoding') &&
515	$response->header('Content-Encoding') eq 'gzip') {
516	$stats{compressed_pages} += do {use bytes; length($response->content)};
517	$response->content(Compress::Zlib::memGunzip($response->content));
518	}
519	return $response->content;
520	}
521
522	######################################################################################################
523
524	sub log
525	{
526	my ($entry) = @_;
527	printf "[%d] %s\n", time, $entry;
528	}
529
530	######################################################################################################
531
532	sub print_stats
533	{
534	printf "[%d] %s v%s completed in %0.2f seconds", time, $progname, $version, tv_interval($script_start_time);
535	foreach my $key (sort keys %stats) {
536	printf ", %d %s",$stats{$key},$key;
537	}
538	printf "\n";
539	}
540
541	######################################################################################################
542	# descend a structure and clean up various things, including stripping
543	# leading/trailing spaces in strings, translations of html stuff etc
544	# -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
545
546	my %amp;
547	BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
548
549	sub cleanup {
550	my $x = shift;
551	if (ref $x eq "REF") { cleanup($_) }
552	elsif (ref $x eq "HASH") { cleanup(\$_) for values %$x }
553	elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
554	elsif (defined $$x) {
555	$$x =~ s/&(#(\d+)\|(.*?));/ $2 ? chr($2) : $amp{$3}\|\|' ' /eg;
556	$$x =~ s/[^\x20-\x7f]/ /g;
557	$$x =~ s/(^\s+\|\s+$)//g;
558	}
559	}
560
561	######################################################################################################
562
563	sub get_station_close
564	{
565	my ($xmlid,$url) = @_;
566	my $tries = 0;
567	my $tree;
568	while (($tries < 5) && (!$tree)) {
569	$tries++;
570	&log("fetching (weekly) station close data for $xmlid");
571	my $data = &get_url($url);
572	$tree = HTML::TreeBuilder->new_from_content($data) if ((defined $data) && ($data ne ""));
573
574	if ((!$tree) && ($tries < 5)) {
575	# slow down ..
576	my $waittime = ($tries*20)+int(rand(20));
577	&log("failed to fetch $url, retrying in $waittime secs");
578	sleep($waittime);
579	$stats{slept_for} += $waittime;
580	}
581	}
582	if (!defined $tree) {
583	&log("failed to fetch $url after $tries attempts; skipping");
584	return;
585	}
586
587	my $to_skip = $opt_offset;
588	my $daynum = 0;
589	my $last_td_text;
590
591	foreach my $tree_td ($tree->look_down('_tag' => 'td')) {
592	if ($tree_td->as_text() =~ /^\.\.\.programs start at /) {
593	if (defined $last_td_text) {
594	if ($to_skip > 0) {
595	$to_skip--;
596	} else {
597	# 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
598	my @timeattr = localtime($starttime + ($daynum*86400));
599	$timeattr[0] = 0; # zero seconds
600
601	if ($last_td_text =~ /^(\d+):(\d+)(.)m/) {
602	$timeattr[2] = $1; # hour
603	$timeattr[1] = $2; # min
604
605	if ($3 eq "p") {
606	# pm
607	$timeattr[2] += 12 if ($timeattr[2] != 12);
608	}
609	my $found_time = mktime(@timeattr);
610
611	if ($3 eq "a") {
612	# am - must be tomorrow
613	if ($timeattr[2] == 12) {
614	$found_time += (126060); # 12:xx am
615	} else {
616	$found_time += (246060);
617	}
618	}
619
620	$daynum++;
621	$station_close_data[$daynum] = $found_time;
622
623	printf "station close time for day %d is %s\n",
624	$daynum, (strftime "%Y%m%d%H%M", localtime($found_time))
625	if $debug;
626	}
627	}
628	}
629	}
630	$last_td_text = $tree_td->as_text();
631	}
632	}
633
634	######################################################################################################

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/abc_website @ 299

Download in other formats: