Context Navigation

abc_website @ 783

Revision 783, 23.7 kB (checked in by paul, 6 years ago)
abc_website: limit detail page failures
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 and 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	# 3.00 23may07 merged abc/abc2 together again, abc_website now does both!
20	# 3.04 12jun07 abc website format change
21
22	use strict;
23
24	my $progname = "abc_website";
25	my $version = "3.05";
26
27	use LWP::UserAgent;
28	use XMLTV;
29	use POSIX qw(strftime mktime);
30	use Getopt::Long;
31	use HTML::TreeBuilder;
32	use Data::Dumper;
33	use Storable;
34	use Shepherd::Common;
35
36	#
37	# constants
38	#
39	my $urls;
40	$urls->{station_close}->{ABC} = "http://www.abc.net.au/tv/guide/abctvweekguide.htm";
41	$urls->{station_close}->{ABC2} = "http://www.abc.net.au/tv/guide/abc2weekguide.htm";
42	$urls->{guide}->{ABC} = "http://www.abc.net.au/tv/guide/netw";
43	$urls->{guide}->{ABC2} = "http://www.abc.net.au/tv/guide/abc2";
44
45	#
46	# some initial cruft
47	#
48
49	my $script_start_time = time;
50	my %stats;
51	my $channels, my $opt_channels, my $gaps;
52	my $tv_guide;
53	my $data_cache;
54	my $override_settings = { };
55	my $station_close_data;
56	my $writer;
57	$\| = 1;
58
59	#
60	# parse command line
61	#
62
63	my $opt_days = 7; # default
64	my $opt_offset = 0; # default
65	my $opt_outputfile = $progname.".xmltv"; # default
66	my $opt_configfile = $progname.".conf"; # ignored
67	my $opt_cache_file = $progname.".storable.cache";
68	my $opt_channels_file= "";
69	my $opt_gaps_file= "";
70	my $opt_no_cache = 0;
71	my $opt_cheap = 0;
72	my $opt_fast = 0;
73	my $opt_do_extra_days = 0;
74	my $opt_set = "";
75	my $opt_help = 0;
76	my $opt_version = 0;
77	my $opt_desc = 0;
78	my $debug = 0;
79	my $lang = "en";
80	my $region = 94;
81	my $time_offset = 0;
82	my $ignored_setting;
83
84	GetOptions(
85	'region=i' => \$region,
86	'days=i' => \$opt_days,
87	'offset=i' => \$opt_offset,
88	'timezone=s' => \$ignored_setting,
89	'channels_file=s' => \$opt_channels_file,
90	'gaps_file=s' => \$opt_gaps_file,
91	'output=s' => \$opt_outputfile,
92	'config-file=s' => \$opt_configfile,
93	'cache-file=s' => \$opt_cache_file,
94	'do-extra-days' => \$opt_do_extra_days,
95	'fast' => \$opt_fast,
96	'no-cache' => \$opt_no_cache,
97	'cheap' => \$opt_cheap,
98	'debug+' => \$debug,
99	'warper' => \$ignored_setting,
100	'lang=s' => \$lang,
101	'obfuscate' => \$ignored_setting,
102	'no-retry' => \$ignored_setting,
103	'set=s' => \$opt_set,
104	'help' => \$opt_help,
105	'verbose' => \$opt_help,
106	'version' => \$opt_version,
107	'ready' => \$opt_version,
108	'desc' => \$opt_desc,
109	'v' => \$opt_help);
110
111	&help if ($opt_help);
112
113	if ($opt_version \|\| $opt_desc) {
114	printf "%s %s\n",$progname,$version;
115	printf "%s is a details-aware grabber that collects decent quality data using the ABC website for ABC/ABC2 only.",$progname if $opt_desc;
116	exit(0);
117	}
118
119	&set_override if ($opt_set ne "");
120
121	die "no channel file specified, see --help for instructions\n", if ($opt_channels_file eq "");
122
123	#
124	# go go go!
125	#
126
127	my $starttime = time;
128	&read_cache if ($opt_no_cache == 0);
129
130	# read channels file
131	die "WARNING: channels file $opt_channels_file could not be read: $!\n" if (!-r $opt_channels_file);
132	local (@ARGV, $/) = ($opt_channels_file);
133	no warnings 'all'; eval <>; die "$@" if $@;
134
135	die "nothing to do; neither ABC nor ABC2 in channels lineup!\n" if ((!defined $channels->{ABC}) && (!defined $channels->{ABC2}));
136
137	&log(sprintf "going to %s%s %s%d%s days%s of data for ABC(%s), ABC2(%s) into %s (%s)",
138	($opt_gaps_file ne "" ? "micro-gap " : ""),
139	($opt_cheap ? "verify (cache-validate)" : "grab"),
140	($opt_do_extra_days ? "somewhere between " : ""),
141	$opt_days,
142	($opt_do_extra_days ? " to 28" : ""),
143	($opt_offset ? " (skipping first $opt_offset days)" : ""),
144	(defined $channels->{ABC} ? "yes" : "no"),
145	(defined $channels->{ABC2} ? "yes" : "no"),
146	$opt_outputfile,
147	($opt_no_cache ? "without caching" : "with caching"));
148
149	# if just filling in microgaps, parse gaps
150	if ($opt_gaps_file ne "") {
151	die "WARNING: gaps_file $opt_gaps_file could not be read: $!\n" if (!-r $opt_gaps_file);
152	local (@ARGV, $/) = ($opt_gaps_file);
153	no warnings 'all'; eval <>; die "$@" if $@;
154	}
155
156	my %writer_args = ( encoding => 'ISO-8859-1' );
157	my $fh = new IO::File(">$opt_outputfile") \|\| die "can't open $opt_outputfile: $!";
158	$writer_args{OUTPUT} = $fh;
159
160	$writer = new XMLTV::Writer(%writer_args);
161	$writer->start( { 'source-info-name' => "$progname $version", 'generator-info-name' => "$progname $version"} );
162	$writer->write_channel( { 'display-name' => [[ "ABC", $lang ]], 'id' => $channels->{ABC} } ) if (defined $channels->{ABC});
163	$writer->write_channel( { 'display-name' => [[ "ABC2", $lang ]], 'id' => $channels->{ABC2} } ) if (defined $channels->{ABC2});
164
165	if (defined $channels->{ABC}) {
166	&get_station_close($channels->{ABC}, $urls->{station_close}->{ABC});
167	&get_abc_data($channels->{ABC}, $urls->{guide}->{ABC},'ABC');
168	}
169
170	if (defined $channels->{ABC2}) {
171	&get_station_close($channels->{ABC2}, $urls->{station_close}->{ABC2});
172	&get_abc_data($channels->{ABC2}, $urls->{guide}->{ABC2},'ABC2');
173	}
174
175	&write_cache if ($opt_no_cache == 0);
176
177	$writer->end;
178
179	&print_stats;
180	exit(0);
181
182	######################################################################################################
183	# help
184
185	sub help
186	{
187	print<<EOF
188	$progname $version
189
190	options are as follows:
191	--help show these help options
192	--days=N fetch 'n' days of data (default: $opt_days)
193	--output=file send xml output to file (default: "$opt_outputfile")
194	--config-file=file (ignored - historically used by grabbers not not this one)
195	--no-cache don't use a cache to optimize (reduce) number of web queries
196	--cheap validate contents of cache - fetch summary only, not details
197	--cache-file=file where to store cache (default "$opt_cache_file")
198	--fast don't run slow - get data as quick as you can - not recommended
199	--debug increase debug level
200	--do-extra-days fetch extra (21 days) from ABC website
201	--lang=[s] set language of xmltv output data (default $lang)
202
203	--region=N set region for where to collect data from (default: $region)
204	--channels_file=file where to get channel data from (if not set manually)
205
206	--set (option):(1/0) setting override options (1=enable, 0=disable)
207	do_extra_days:1/0 enable/disable fetching up to 24 days
208	fast:1/0 enable/disable extra-fast grab speed (not recommended)
209	debug:1/0 enable/disable debugging
210
211	EOF
212	;
213
214	exit(0);
215	}
216
217	######################################################################################################
218
219	sub set_override
220	{
221	&read_cache;
222	my ($setting, $val) = split(/:/,$opt_set);
223
224	die "--set format is (setting):(value) where value is 0 for disable, 1 for enable.\n"
225	if (($val ne "0") && ($val ne "1"));
226
227	die "unknown '--set' parameter '$setting', see --help for details.\n"
228	if (($setting ne "do_extra_days") &&
229	($setting ne "fast") &&
230	($setting ne "debug"));
231
232	$override_settings->{$setting} = $val;
233	printf "%s: override parameter %s: %s\n", $progname, $setting, ($val eq "0" ? "disabled" : "enabled");
234
235	&write_cache;
236	exit(0);
237	}
238
239	######################################################################################################
240	# populate cache
241
242	sub read_cache
243	{
244	if (-r $opt_cache_file) {
245	my $store = Storable::retrieve($opt_cache_file);
246	$data_cache = $store->{data_cache};
247	$override_settings = $store->{override_settings};
248
249	# apply settings overrides
250	$opt_do_extra_days = 1 if ((defined $override_settings->{do_extra_days}) && ($override_settings->{do_extra_days} == 1));
251	$opt_fast = 1 if ((defined $override_settings->{fast}) && ($override_settings->{fast} == 1));
252	$debug = 1 if ((defined $override_settings->{debug}) && ($override_settings->{debug} > 0));
253	} else {
254	printf "WARNING: no programme cache $opt_cache_file - have to fetch all details\n";
255
256	# try to write to it - if directory doesn't exist this will then cause an error
257	&write_cache;
258	}
259	}
260
261	######################################################################################################
262	# write out updated cache
263
264	sub write_cache
265	{
266	# cleanup old entries from cache
267	for my $cache_key (keys %{$data_cache}) {
268	my ($starttime, @rest) = split(/,/,$cache_key);
269	if ($starttime < (time-86400)) {
270	delete $data_cache->{$cache_key};
271	$stats{removed_items_from_cache}++;
272	}
273	}
274
275	my $store;
276	$store->{data_cache} = $data_cache;
277	$store->{override_settings} = $override_settings;
278	Storable::store($store, $opt_cache_file);
279	}
280
281	######################################################################################################
282
283	sub get_abc_data
284	{
285	my ($xmlid,$urlbase,$chan_id) = @_;
286	my $try_to_add_abc_detail;
287	my $unprocessed_programmes = 0;
288	my $stop_fetching = 0;
289	my @unprocessed_progname, my @unprocessed_starttime, my @unprocessed_url, my @unprocessed_day;
290
291	my $to_skip = $opt_offset;
292	my $daynum = 0;
293	my @gap_s, my @gap_e;
294
295	$opt_days = 28 if (($opt_do_extra_days) && ($opt_gaps_file eq "") && ($opt_offset == 0) && ($opt_days == 7));
296	my $days_left = $opt_days;
297
298	DAYS: while ($days_left > 0) {
299	my $currtime = $starttime + ($daynum * 86400);
300	$days_left--;
301	$daynum++;
302
303	if ($to_skip > 0) {
304	$to_skip--;
305	next;
306	}
307
308	if ($opt_gaps_file ne "") { # micro-gap mode!
309	my $found_gap_match = 0;
310
311	if ((defined $gaps) && (defined $gaps->{$chan_id})) {
312	foreach my $g (@{($gaps->{$chan_id})}) {
313	my ($s, $e) = split(/-/,$g);
314	if (($s >= $currtime) && ($s <= ($currtime+86400))) {
315	$found_gap_match++;
316	push(@gap_s,$s);
317	push(@gap_e,$e);
318	printf "including day %d channel '%s' gap start %d, gap end %d\n",
319	$daynum, $chan_id, $s, $e if $debug;
320	}
321	}
322	}
323	next if (!$found_gap_match); # no gaps for this day - skip!
324	}
325
326	my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
327	$timeattr[0] = 0; # zero seconds
328
329	my $url = sprintf "%s/%s.htm",$urlbase, POSIX::strftime("%Y%m/%Y%m%d",localtime($currtime));
330
331	my $tries = ($daynum > 7 ? 1 : 5);
332	&log((sprintf "Fetching %s summary data: day %d of %d",
333	$xmlid, $daynum, $opt_days ));
334	my $data = Shepherd::Common::get_url(url => $url, retries => ($tries-1), debug => $debug * 2);
335	my $tree;
336	$tree = HTML::TreeBuilder->new_from_content($data) if ($data);
337
338	if (!defined $tree) {
339	&log("failed to fetch $url after $tries attempts; skipping");
340
341	die "couldn't fetch first daily page after $tries attempts, network is probably down. aborting!"
342	if ((!defined $stats{abc_daily_pages}) \|\| ($stats{abc_daily_pages} == 0));
343
344	if ($daynum > 7) {
345	&log("failed to fetch $url, assuming we only have $daynum days..");
346	$days_left = 0;
347	}
348	next;
349	}
350
351	my $seen_programmes = 0;
352	my $seen_pm = 0;
353
354	for ($tree->look_down('_tag' => 'div', 'id' => 'epgWrap')) {
355	foreach my $tree_tr ($_->look_down('_tag' => 'tr')) {
356	my $tree_tr_class = $tree_tr->attr('class');
357	next if ((!defined $tree_tr_class) \|\| ($tree_tr_class !~ /alt/i));
358
359	if (my $tree_row = $tree_tr->look_down('_tag' => 'th')) {
360	if ($tree_row->as_text() =~ /^(\d+):(\d+)(.)m/) {
361	$timeattr[2] = $1; # hour
362	$timeattr[1] = $2; # min
363
364	if ($3 eq "p") {
365	# pm
366	$timeattr[2] += 12 if ($timeattr[2] != 12);
367	$seen_pm = 1;
368	}
369	my $found_time = mktime(@timeattr);
370
371	# handle programmes that are after midnight
372	if (($seen_pm) && ($3 eq "a")) {
373	if ($timeattr[2] == 12) {
374	$found_time += (126060); # 12:xx am
375	} else {
376	$found_time += (246060);
377	}
378	}
379
380	if ($tree_tr->look_down('_tag' => 'td', 'class' => 'prg')) {
381	foreach my $prog ($tree_tr->look_down('_tag' => 'a')) {
382	my $programme = $prog->as_text();
383	my $progurl = $prog->attr('href');
384
385	if ($progurl =~ /^\/tv\/guide\//) {
386	printf "day %d time '%s' (%s) prog: %s url: %s\n",
387	$daynum,$tree_row->as_text(),POSIX::strftime("%Y%m%d%H%M", localtime($found_time)),
388	$programme,$progurl if ($debug && $debug > 1);
389
390	$unprocessed_progname[$unprocessed_programmes] = $programme;
391	$unprocessed_starttime[$unprocessed_programmes] = $found_time;
392	$unprocessed_day[$unprocessed_programmes] = $daynum;
393	$unprocessed_url[$unprocessed_programmes] = "http://www.abc.net.au".$progurl;
394	$unprocessed_programmes++;
395	$seen_programmes++;
396	} else {
397	printf "ignoring prog %s because url %s is not a detail page\n",
398	$programme,$progurl if $debug;
399	}
400	}
401	}
402	}
403	}
404	}
405	}
406
407	$tree->delete;
408
409	if ($seen_programmes > 0) {
410	$stats{abc_daily_pages}++;
411
412	if ((defined $station_close_data) && (defined $station_close_data->{$xmlid}) &&
413	(defined $station_close_data->{$xmlid}->[$daynum])) {
414	# get station-close time from the previously-fetched "weekly programme guide"
415
416	$unprocessed_progname[$unprocessed_programmes] = "Station Close";
417	$unprocessed_starttime[$unprocessed_programmes] = $station_close_data->{$xmlid}->[$daynum];
418	$unprocessed_day[$unprocessed_programmes] = $daynum;
419	$unprocessed_url[$unprocessed_programmes] = "";
420	$unprocessed_programmes++;
421	}
422	} else {
423	# if we were trying to fetch more than 7 days, stop on first day with no programmes
424	if ($daynum > 7) {
425	&log("failed to fetch $url, assuming we only have $daynum days..");
426	$days_left = 0;
427	next DAYS;
428	}
429	}
430	}
431
432	# have 'n' days of this channel unprocessed - process it!
433	&log((sprintf "have summary data for %s, now fetching detail pages for up to %d programmes..",$chan_id,$unprocessed_programmes-2));
434
435	for (my $i = 0; $i < ($unprocessed_programmes-1); $i++) {
436	# if we've found a programme which is between days, evaluate whether we can
437	# use it or need to drop it (because we won't necessarily have a 'stop' time
438	if (($unprocessed_day[$i] != $unprocessed_day[($i+1)]) &&
439	($unprocessed_progname[$i] ne "Station Close")) {
440	# we'd normally throw away last programme from each day - we can't use it
441	# as we don't have a 'stop' time for it.
442	# with some ABC programming, ABC no longer indicate any station close
443	# on some days - they're broadcasting 24 hours.
444	# only throw away the last programme if:
445	# 1. it is seen to run longer than 3.5 hours
446	# 2. it is a different title
447	if ((($unprocessed_starttime[$i+1] - $unprocessed_starttime[$i]) > (3.5*3600)) &&
448	($unprocessed_progname[$i] ne $unprocessed_progname[$i+1])) {
449	printf "throwing away '%s' (%s) because we won't have a valid stop time (%s) and title is different (%s)\n",
450	$unprocessed_progname[$i],
451	POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i])),
452	POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i+1])),
453	$unprocessed_progname[$i+1]
454	if $debug;
455	next;
456	}
457	}
458
459	# if we are micro-gap fetching, only include programmes which match our micro gaps
460	if ($opt_gaps_file ne "") {
461	my $found_gap_match = 0;
462	for (my $g_num = 0; $g_num < $#gap_s; $g_num++) {
463	$found_gap_match++
464	if ((($gap_s[$g_num] >= $unprocessed_starttime[$i]) &&
465	($gap_s[$g_num] <= $unprocessed_starttime[$i+1])) \|\|
466	(($gap_e[$g_num] >= $unprocessed_starttime[$i]) &&
467	($gap_e[$g_num] <= $unprocessed_starttime[$i+1])) \|\|
468	(($gap_s[$g_num] <= $unprocessed_starttime[$i]) &&
469	($gap_e[$g_num] >= $unprocessed_starttime[$i+1])));
470	}
471	next if (!$found_gap_match);
472
473	$stats{programme_gaps_used}++;
474	printf "gap-fetching: including prog '%s', start %d, end %d\n", $unprocessed_progname[$i],
475	$unprocessed_starttime[$i], $unprocessed_starttime[$i+1] if $debug;
476	}
477
478	$stats{programmes}++;
479	my $prog;
480
481	my $cache_key = sprintf "%d,%d,%s,%s", $unprocessed_starttime[$i], $unprocessed_starttime[$i+1], $xmlid, $unprocessed_progname[$i];
482
483	$prog->{'channel'} = $xmlid;
484	$prog->{'start'} = POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i]));
485	$prog->{'stop'} = POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i+1]));
486	$prog->{'title'} = [[ $unprocessed_progname[$i], $lang ]];
487
488	if (defined $data_cache->{$cache_key}) {
489	$stats{used_cached_data}++;
490	} else {
491	if ((!$opt_cheap) && ($unprocessed_url[$i] ne "")) {
492	&get_one_abc_event($cache_key, $unprocessed_url[$i]);
493
494	if (($stats{portal_detail_pages} % 25) == 1) {
495	&log((sprintf " .. at %s detail page %d of %d (used %d cached entries)",
496	$xmlid, ($i+1), $unprocessed_programmes-2,
497	(defined $stats{used_cached_data} ? $stats{used_cached_data} : 0)));
498
499	if (!$opt_fast) {
500	# slow down ..
501	my $waittime = 3 + int(rand(10));
502	sleep($waittime);
503	$stats{slept_for} += $waittime;
504	}
505	}
506	}
507	}
508
509	if (defined $data_cache->{$cache_key}) {
510	$prog->{'sub-title'} = [[ $data_cache->{$cache_key}->{subtitle}, $lang ]]
511	if $data_cache->{$cache_key}->{subtitle};
512	$prog->{'desc'} = [[ $data_cache->{$cache_key}->{desc}, $lang ]]
513	if $data_cache->{$cache_key}->{desc};
514	$prog->{'category'} = [[ $data_cache->{$cache_key}->{genre}, $lang ]]
515	if $data_cache->{$cache_key}->{genre};
516	$prog->{'previously-shown'} = { } if (defined $data_cache->{$cache_key}->{repeat});
517	$prog->{'subtitles'} = [ { 'type' => 'teletext' } ] if (defined $data_cache->{$cache_key}->{cc});
518	$prog->{'rating'} = [ [ $data_cache->{$cache_key}->{rating}, 'ABA', undef] ]
519	if (defined $data_cache->{$cache_key}->{rating});
520	}
521
522	Shepherd::Common::cleanup($prog);
523	$writer->write_programme($prog);
524	}
525	}
526
527	######################################################################################################
528
529	sub get_one_abc_event
530	{
531	my ($cache_key, $url) = @_;
532
533	if ($stats{failed_to_fetch_portal_detail_page} >= 3 or $stats{failed_to_parse_portal_detail_page} >= 9)
534	{
535	&log("Skipping detail page because too many failures.");
536	return;
537	}
538
539	my $seen_programme = 0;
540	my $data = Shepherd::Common::get_url(url => $url, debug => $debug);
541	my $tree = HTML::TreeBuilder->new_from_content($data) if ($data);
542	if (!defined $tree) {
543	&log("failed to fetch $url; skipping");
544	$stats{failed_to_fetch_portal_detail_page}++;
545	return;
546	}
547	Shepherd::Common::log("get_one_abc_event ".$url) if ($debug);
548
549	if (my $inner_tree = $tree->look_down('_tag' => 'div', 'id' => 'prgTitle')) {
550	my $event_title = undef, my $event_subtitle = undef, my $event_description = undef, my $event_genre = undef;
551
552	if (my $prog_h1 = $inner_tree->look_down('_tag' => 'h1')) {
553	my $full_title = $prog_h1->as_HTML();
554	$full_title =~ s/(^<h1>\|<\/h1>$)//g;
555	($event_title,$event_subtitle) = split(/ - /,$full_title);
556
557	$event_title =~ s/(<[a-zA-Z0-9]+\>)//g; # remove html tags
558	$event_title =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
559	Shepherd::Common::log(" - decoded title '".$event_title."'") if ($debug);
560
561	if ($event_subtitle) {
562	$event_subtitle =~ s/(<[\/a-zA-Z0-9]+\>)//g; # remove html tags
563	$event_subtitle =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
564	$data_cache->{$cache_key}->{subtitle} = $event_subtitle;
565	Shepherd::Common::log(" - decoded subtitle '".$event_subtitle."'") if ($debug);
566	}
567	}
568
569	if (my $prog_g = $inner_tree->look_down('_tag' => 'span', 'class' => 'smlTxt')) {
570	if (my $prog_genre_tag = $prog_g->look_down('_tag' => 'a')) {
571	my $prog_genre_text = $prog_genre_tag->as_text();
572	$data_cache->{$cache_key}->{genre} = Shepherd::Common::translate_category($prog_genre_text);
573	Shepherd::Common::log(" - decoded genre '$prog_genre_text'") if ($debug);
574	}
575
576	my $other_text = $prog_g->as_text();
577	$other_text =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
578	$other_text =~ s/(^\s+\|\s+$)//g; # strip trailing/leading spaces
579
580	if ($other_text =~ /^(.)CC(.)$/) {
581	$data_cache->{$cache_key}->{cc} = 1;
582	Shepherd::Common::log(" - decoded CC from '$other_text'") if ($debug);
583	$other_text = $1.$2; # strip CC
584	}
585
586	if ($other_text =~ /^(.)Repeat(.)$/) {
587	$data_cache->{$cache_key}->{repeat} = 1;
588	Shepherd::Common::log(" - decoded Repeat from '$other_text'") if ($debug);
589	$other_text = $1.$2; # strip Repeat
590	}
591
592	# any remaining text should be rating
593	if ($other_text =~ /\s+(.*)$/) {
594	my $rating_text = $1;
595	$rating_text =~ s/[^\x20-\x7f\x0a]/ /g;
596	if ($rating_text =~ /^\s(\w+)\s$/) {
597	$data_cache->{$cache_key}->{rating} = $1;
598	Shepherd::Common::log(" - decoded Rating '".$1."' from '$other_text'") if ($debug);
599	}
600	}
601	}
602
603	if (my $prog_desc = $tree->look_down('_tag' => 'div', 'class' => 'panelItemStory')) {
604	# gather description
605	foreach my $para ($prog_desc->look_down('_tag' => 'p')) {
606	$data_cache->{$cache_key}->{desc} .= $para->as_text() . "\n";
607	Shepherd::Common::log("added desc '".$para->as_text()."'") if ($debug);
608	}
609	}
610
611	if (defined $data_cache->{$cache_key}->{desc}) {
612	$data_cache->{$cache_key}->{desc} =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
613	$data_cache->{$cache_key}->{desc} =~ s/(^\s+\|\s+$)//g; # strip trailing/leading spaces
614	delete $data_cache->{$cache_key}->{desc} if ($data_cache->{$cache_key}->{desc} eq "");
615	}
616
617	$seen_programme++;
618	$stats{added_cached_data}++;
619
620	&write_cache if (($opt_no_cache == 0) &&
621	(($stats{added_cached_data} % 30) == 0)); # incrementally write
622	}
623
624	$tree->delete;
625
626	if ($seen_programme == 0) {
627	printf "WARNING: failed to parse any programme data from '%s' - blocked/rate-limited/format-changed?\n",$url;
628	$stats{failed_to_parse_portal_detail_page}++;
629	return;
630	}
631	$stats{portal_detail_pages}++;
632	}
633
634	######################################################################################################
635
636	sub log
637	{
638	my ($entry) = @_;
639	printf "%s\n", $entry;
640	}
641
642	######################################################################################################
643
644	sub print_stats
645	{
646	printf "STATS: %s v%s completed in %d seconds", $progname, $version, (time-$script_start_time);
647	foreach my $key (sort keys %stats) {
648	printf ", %d %s",$stats{$key},$key;
649	}
650	printf "\n";
651	}
652
653	######################################################################################################
654
655	sub get_station_close
656	{
657	my ($xmlid,$url) = @_;
658	&log("fetching (weekly) station close data for $xmlid");
659	my $data = Shepherd::Common::get_url(url => $url, debug => $debug);
660	my $tree = HTML::TreeBuilder->new_from_content($data) if ($data);
661
662	if (!defined $tree) {
663	&log("failed to fetch $url; skipping");
664	return;
665	}
666
667	my $to_skip = $opt_offset;
668	my $daynum = 0;
669	my $last_td_text;
670
671	foreach my $tree_td ($tree->look_down('_tag' => 'td')) {
672	if ($tree_td->as_text() =~ /^\.\.\.programs start at /) {
673	if (defined $last_td_text) {
674	if ($to_skip > 0) {
675	$to_skip--;
676	} else {
677	# 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
678	my @timeattr = localtime($starttime + ($daynum*86400));
679	$timeattr[0] = 0; # zero seconds
680
681	if ($last_td_text =~ /^(\d+):(\d+)(.)m/) {
682	$timeattr[2] = $1; # hour
683	$timeattr[1] = $2; # min
684
685	if ($3 eq "p") {
686	# pm
687	$timeattr[2] += 12 if ($timeattr[2] != 12);
688	}
689	my $found_time = mktime(@timeattr);
690
691	if ($3 eq "a") {
692	# am - must be tomorrow
693	if ($timeattr[2] == 12) {
694	$found_time += (126060); # 12:xx am
695	} else {
696	$found_time += (246060);
697	}
698	}
699
700	$daynum++;
701	$station_close_data->{$xmlid}->[$daynum] = $found_time;
702
703	printf "station close time for %s day %d is %s\n",
704	$xmlid, $daynum, POSIX::strftime("%Y%m%d%H%M", localtime($found_time))
705	if $debug;
706	}
707	}
708	}
709	}
710	$last_td_text = $tree_td->as_text();
711	}
712	$tree->delete;
713	}
714
715	######################################################################################################

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/abc_website @ 783

Download in other formats: