Context Navigation

abc_website @ 586

Revision 586, 23.9 kB (checked in by lincoln, 6 years ago)
remove support for previous-deprecated Data::Dumper cache from abc_website/abc2_website/ten_website/ninemsn
Property svn:executable set to ``*

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/abc_website @ 586

Download in other formats: