Context Navigation

abc_website @ 810

Revision 810, 24.8 kB (checked in by max, 6 years ago)
abc_website: insert initial Station Close if necessary to fill day 1 gap left when grabber is run during a Station Close period
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.08";
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 @gap_s, my @gap_e;
292
293	my $daynum = $opt_offset;
294	$opt_days = 28 if (($opt_do_extra_days) && ($opt_gaps_file eq "") && ($opt_offset == 0) && ($opt_days == 7));
295	my $days_left = $opt_days - $opt_offset;
296
297	my @timeattr = localtime($starttime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
298	# if now before 4:30am we need the previous day due to the guide starting at 4:30am
299	if (($daynum == 0 and ($timeattr[2] < 4 or ($timeattr[2] == 4 and $timeattr[1] < 30))) or $daynum < 0) {
300	$daynum = -1;
301	$days_left = $opt_days + 1;
302	} elsif ($daynum > 0) {
303	$daynum--;
304	$days_left++;
305	}
306	$timeattr[0] = 0; # zero seconds
307	$timeattr[3] += $daynum - 1; # day
308
309	DAYS: while ($days_left > 0) {
310	$days_left--;
311	$daynum++;
312
313	$timeattr[1] = 30; # minutes
314	$timeattr[2] = 4; # hours 4:30am
315	$timeattr[3]++; # day
316	my $currtime = mktime(@timeattr);
317
318	if ($opt_gaps_file ne "") { # micro-gap mode!
319	my $found_gap_match = 0;
320
321	if ((defined $gaps) && (defined $gaps->{$chan_id})) {
322	foreach my $g (@{($gaps->{$chan_id})}) {
323	my ($s, $e) = split(/-/,$g);
324	if (($s >= $currtime) && ($s <= ($currtime+86400))) {
325	$found_gap_match++;
326	push(@gap_s,$s);
327	push(@gap_e,$e);
328	printf "including day %d channel '%s' gap start %d, gap end %d\n",
329	$daynum, $chan_id, $s, $e if $debug;
330	}
331	}
332	}
333	next if (!$found_gap_match); # no gaps for this day - skip!
334	}
335
336	my $url = sprintf "%s/%s.htm",$urlbase, POSIX::strftime("%Y%m/%Y%m%d",localtime($currtime));
337
338	my $tries = ($daynum > 7 ? 1 : 5);
339	&log((sprintf "Fetching %s summary data: day %d of %d",
340	$xmlid, $daynum, $opt_days ));
341	my $data = Shepherd::Common::get_url(url => $url, retries => ($tries-1), debug => $debug * 2);
342	my $tree;
343	$tree = HTML::TreeBuilder->new_from_content($data) if ($data);
344
345	if (!defined $tree) {
346	&log("failed to fetch $url after $tries attempts; skipping");
347
348	die "couldn't fetch first daily page after $tries attempts, network is probably down. aborting!"
349	if ((!defined $stats{abc_daily_pages}) \|\| ($stats{abc_daily_pages} == 0));
350
351	if ($daynum > 7) {
352	&log("failed to fetch $url, assuming we only have $daynum days..");
353	$days_left = 0;
354	}
355	next;
356	}
357
358	my $seen_programmes = 0;
359	my $seen_pm = 0;
360
361	for ($tree->look_down('_tag' => 'div', 'id' => 'epgWrap')) {
362	foreach my $tree_tr ($_->look_down('_tag' => 'tr')) {
363	my $tree_tr_class = $tree_tr->attr('class');
364	next if ((!defined $tree_tr_class) \|\| ($tree_tr_class !~ /alt/i));
365
366	if (my $tree_row = $tree_tr->look_down('_tag' => 'th')) {
367	if ($tree_row->as_text() =~ /^(\d+):(\d+)(.)m/) {
368	$timeattr[2] = $1; # hour
369	$timeattr[1] = $2; # min
370
371	if ($3 eq "p") {
372	# pm
373	$timeattr[2] += 12 if ($timeattr[2] != 12);
374	$seen_pm = 1;
375	}
376	my $found_time = mktime(@timeattr);
377
378	# handle programmes that are after midnight
379	if (($seen_pm) && ($3 eq "a")) {
380	if ($timeattr[2] == 12) {
381	$found_time += (126060); # 12:xx am
382	} else {
383	$found_time += (246060);
384	}
385	}
386
387	if ($tree_tr->look_down('_tag' => 'td', 'class' => 'prg')) {
388	foreach my $prog ($tree_tr->look_down('_tag' => 'a')) {
389	my $programme = $prog->as_text();
390	my $progurl = $prog->attr('href');
391
392	if ($progurl =~ /^\/tv\/guide\//) {
393	printf "day %d time '%s' (%s) prog: %s url: %s\n",
394	$daynum,$tree_row->as_text(),POSIX::strftime("%Y%m%d%H%M", localtime($found_time)),
395	$programme,$progurl if ($debug && $debug > 1);
396	# If it's day 1 and the first programme found
397	# starts later than now, insert a Station Close
398	# from now until then. Without this, we have a
399	# hole if run during a Station Close period
400	# (eg midnight - 6am).
401	if (!$seen_programmes and $daynum == 1 and $found_time > $script_start_time)
402	{
403	&log("Inserting initial Station Close");
404	$unprocessed_progname[$unprocessed_programmes] = "Station Close";
405	$unprocessed_starttime[$unprocessed_programmes] = $script_start_time;
406	$unprocessed_day[$unprocessed_programmes] = $daynum;
407	$unprocessed_url[$unprocessed_programmes] = "";
408	$unprocessed_programmes++;
409	}
410
411	$unprocessed_progname[$unprocessed_programmes] = $programme;
412	$unprocessed_starttime[$unprocessed_programmes] = $found_time;
413	$unprocessed_day[$unprocessed_programmes] = $daynum;
414	$unprocessed_url[$unprocessed_programmes] = "http://www.abc.net.au".$progurl;
415	$unprocessed_programmes++;
416	$seen_programmes++;
417	} else {
418	printf "ignoring prog %s because url %s is not a detail page\n",
419	$programme,$progurl if $debug;
420	}
421	}
422	}
423	}
424	}
425	}
426	}
427
428	$tree->delete;
429
430	if ($seen_programmes > 0) {
431	$stats{abc_daily_pages}++;
432
433	if ((defined $station_close_data) && (defined $station_close_data->{$xmlid}) &&
434	(defined $station_close_data->{$xmlid}->[$daynum])) {
435	# get station-close time from the previously-fetched "weekly programme guide"
436	&log("inserting Station Close");
437
438	$unprocessed_progname[$unprocessed_programmes] = "Station Close";
439	$unprocessed_starttime[$unprocessed_programmes] = $station_close_data->{$xmlid}->[$daynum];
440	$unprocessed_day[$unprocessed_programmes] = $daynum;
441	$unprocessed_url[$unprocessed_programmes] = "";
442	$unprocessed_programmes++;
443	}
444	} else {
445	# if we were trying to fetch more than 7 days, stop on first day with no programmes
446	if ($daynum > 7) {
447	&log("failed to fetch $url, assuming we only have $daynum days..");
448	$days_left = 0;
449	next DAYS;
450	}
451	}
452	}
453
454	# have 'n' days of this channel unprocessed - process it!
455	&log((sprintf "have summary data for %s, now fetching detail pages for up to %d programmes..",$chan_id,$unprocessed_programmes-2));
456
457	for (my $i = 0; $i < ($unprocessed_programmes-1); $i++) {
458	# if we've found a programme which is between days, evaluate whether we can
459	# use it or need to drop it (because we won't necessarily have a 'stop' time
460	if (($unprocessed_day[$i] != $unprocessed_day[($i+1)]) &&
461	($unprocessed_progname[$i] ne "Station Close")) {
462	# we'd normally throw away last programme from each day - we can't use it
463	# as we don't have a 'stop' time for it.
464	# with some ABC programming, ABC no longer indicate any station close
465	# on some days - they're broadcasting 24 hours.
466	# only throw away the last programme if:
467	# 1. it is seen to run longer than 3.5 hours
468	# 2. it is a different title
469	if ((($unprocessed_starttime[$i+1] - $unprocessed_starttime[$i]) > (3.5*3600)) &&
470	($unprocessed_progname[$i] ne $unprocessed_progname[$i+1])) {
471	printf "throwing away '%s' (%s) because we won't have a valid stop time (%s) and title is different (%s)\n",
472	$unprocessed_progname[$i],
473	POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i])),
474	POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i+1])),
475	$unprocessed_progname[$i+1]
476	if $debug;
477	next;
478	}
479	}
480
481	# if we are micro-gap fetching, only include programmes which match our micro gaps
482	if ($opt_gaps_file ne "") {
483	my $found_gap_match = 0;
484	for (my $g_num = 0; $g_num <= $#gap_s; $g_num++) {
485	$found_gap_match++
486	if ((($gap_s[$g_num] >= $unprocessed_starttime[$i]) &&
487	($gap_s[$g_num] <= $unprocessed_starttime[$i+1])) \|\|
488	(($gap_e[$g_num] >= $unprocessed_starttime[$i]) &&
489	($gap_e[$g_num] <= $unprocessed_starttime[$i+1])) \|\|
490	(($gap_s[$g_num] <= $unprocessed_starttime[$i]) &&
491	($gap_e[$g_num] >= $unprocessed_starttime[$i+1])));
492	}
493	next if (!$found_gap_match);
494
495	$stats{programme_gaps_used}++;
496	printf "gap-fetching: including prog '%s', start %d, end %d\n", $unprocessed_progname[$i],
497	$unprocessed_starttime[$i], $unprocessed_starttime[$i+1] if $debug;
498	}
499
500	$stats{programmes}++;
501	my $prog;
502
503	my $cache_key = sprintf "%d,%d,%s,%s", $unprocessed_starttime[$i], $unprocessed_starttime[$i+1], $xmlid, $unprocessed_progname[$i];
504
505	$prog->{'channel'} = $xmlid;
506	$prog->{'start'} = POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i]));
507	$prog->{'stop'} = POSIX::strftime("%Y%m%d%H%M", localtime($unprocessed_starttime[$i+1]));
508	$prog->{'title'} = [[ $unprocessed_progname[$i], $lang ]];
509
510	if (defined $data_cache->{$cache_key}) {
511	$stats{used_cached_data}++;
512	} else {
513	if ((!$opt_cheap) && ($unprocessed_url[$i] ne "")) {
514	&get_one_abc_event($cache_key, $unprocessed_url[$i]);
515
516	if (($stats{portal_detail_pages} % 25) == 1) {
517	&log((sprintf " .. at %s detail page %d of %d (used %d cached entries)",
518	$xmlid, ($i+1), $unprocessed_programmes-2,
519	(defined $stats{used_cached_data} ? $stats{used_cached_data} : 0)));
520
521	if (!$opt_fast) {
522	# slow down ..
523	my $waittime = 3 + int(rand(10));
524	sleep($waittime);
525	$stats{slept_for} += $waittime;
526	}
527	}
528	}
529	}
530
531	if (defined $data_cache->{$cache_key}) {
532	$prog->{'sub-title'} = [[ $data_cache->{$cache_key}->{subtitle}, $lang ]]
533	if $data_cache->{$cache_key}->{subtitle};
534	$prog->{'desc'} = [[ $data_cache->{$cache_key}->{desc}, $lang ]]
535	if $data_cache->{$cache_key}->{desc};
536	$prog->{'category'} = [[ $data_cache->{$cache_key}->{genre}, $lang ]]
537	if $data_cache->{$cache_key}->{genre};
538	$prog->{'previously-shown'} = { } if (defined $data_cache->{$cache_key}->{repeat});
539	$prog->{'subtitles'} = [ { 'type' => 'teletext' } ] if (defined $data_cache->{$cache_key}->{cc});
540	$prog->{'rating'} = [ [ $data_cache->{$cache_key}->{rating}, 'ABA', undef] ]
541	if (defined $data_cache->{$cache_key}->{rating});
542	}
543
544	Shepherd::Common::cleanup($prog);
545	$writer->write_programme($prog);
546	}
547	}
548
549	######################################################################################################
550
551	sub get_one_abc_event
552	{
553	my ($cache_key, $url) = @_;
554
555	if ($stats{failed_to_fetch_portal_detail_page} >= 3 or $stats{failed_to_parse_portal_detail_page} >= 9)
556	{
557	&log("Skipping detail page because too many failures.");
558	return;
559	}
560
561	my $seen_programme = 0;
562	my $data = Shepherd::Common::get_url(url => $url, debug => $debug);
563	my $tree = HTML::TreeBuilder->new_from_content($data) if ($data);
564	if (!defined $tree) {
565	&log("failed to fetch $url; skipping");
566	$stats{failed_to_fetch_portal_detail_page}++;
567	return;
568	}
569	Shepherd::Common::log("get_one_abc_event ".$url) if ($debug);
570
571	if (my $inner_tree = $tree->look_down('_tag' => 'div', 'id' => 'prgTitle')) {
572	my $event_title = undef, my $event_subtitle = undef, my $event_description = undef, my $event_genre = undef;
573
574	if (my $prog_h1 = $inner_tree->look_down('_tag' => 'h1')) {
575	my $full_title = $prog_h1->as_HTML();
576	$full_title =~ s/(^<h1>\|<\/h1>$)//g;
577	($event_title,$event_subtitle) = split(/ - /,$full_title);
578
579	$event_title =~ s/(<[a-zA-Z0-9]+\>)//g; # remove html tags
580	$event_title =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
581	Shepherd::Common::log(" - decoded title '".$event_title."'") if ($debug);
582
583	if ($event_subtitle) {
584	$event_subtitle =~ s/(<[\/a-zA-Z0-9]+\>)//g; # remove html tags
585	$event_subtitle =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
586	$data_cache->{$cache_key}->{subtitle} = $event_subtitle;
587	Shepherd::Common::log(" - decoded subtitle '".$event_subtitle."'") if ($debug);
588	}
589	}
590
591	if (my $prog_g = $inner_tree->look_down('_tag' => 'span', 'class' => 'smlTxt')) {
592	if (my $prog_genre_tag = $prog_g->look_down('_tag' => 'a')) {
593	my $prog_genre_text = $prog_genre_tag->as_text();
594	$data_cache->{$cache_key}->{genre} = Shepherd::Common::translate_category($prog_genre_text);
595	Shepherd::Common::log(" - decoded genre '$prog_genre_text'") if ($debug);
596	}
597
598	my $other_text = $prog_g->as_text();
599	$other_text =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
600	$other_text =~ s/(^\s+\|\s+$)//g; # strip trailing/leading spaces
601
602	if ($other_text =~ /^(.)CC(.)$/) {
603	$data_cache->{$cache_key}->{cc} = 1;
604	Shepherd::Common::log(" - decoded CC from '$other_text'") if ($debug);
605	$other_text = $1.$2; # strip CC
606	}
607
608	if ($other_text =~ /^(.)Repeat(.)$/) {
609	$data_cache->{$cache_key}->{repeat} = 1;
610	Shepherd::Common::log(" - decoded Repeat from '$other_text'") if ($debug);
611	$other_text = $1.$2; # strip Repeat
612	}
613
614	# any remaining text should be rating
615	if ($other_text =~ /\s+(.*)$/) {
616	my $rating_text = $1;
617	$rating_text =~ s/[^\x20-\x7f\x0a]/ /g;
618	if ($rating_text =~ /^\s(\w+)\s$/) {
619	$data_cache->{$cache_key}->{rating} = $1;
620	Shepherd::Common::log(" - decoded Rating '".$1."' from '$other_text'") if ($debug);
621	}
622	}
623	}
624
625	if (my $prog_desc = $tree->look_down('_tag' => 'div', 'class' => 'panelItemStory')) {
626	# gather description
627	foreach my $para ($prog_desc->look_down('_tag' => 'p')) {
628	$data_cache->{$cache_key}->{desc} .= $para->as_text() . "\n";
629	Shepherd::Common::log("added desc '".$para->as_text()."'") if ($debug);
630	}
631	}
632
633	if (defined $data_cache->{$cache_key}->{desc}) {
634	$data_cache->{$cache_key}->{desc} =~ s/(^\n\|\n$)//g; # strip trailing/leading blank lines
635	$data_cache->{$cache_key}->{desc} =~ s/(^\s+\|\s+$)//g; # strip trailing/leading spaces
636	delete $data_cache->{$cache_key}->{desc} if ($data_cache->{$cache_key}->{desc} eq "");
637	}
638
639	$seen_programme++;
640	$stats{added_cached_data}++;
641
642	&write_cache if (($opt_no_cache == 0) &&
643	(($stats{added_cached_data} % 30) == 0)); # incrementally write
644	}
645
646	$tree->delete;
647
648	if ($seen_programme == 0) {
649	printf "WARNING: failed to parse any programme data from '%s' - blocked/rate-limited/format-changed?\n",$url;
650	$stats{failed_to_parse_portal_detail_page}++;
651	return;
652	}
653	$stats{portal_detail_pages}++;
654	}
655
656	######################################################################################################
657
658	sub log
659	{
660	my ($entry) = @_;
661	printf "%s\n", $entry;
662	}
663
664	######################################################################################################
665
666	sub print_stats
667	{
668	printf "STATS: %s v%s completed in %d seconds", $progname, $version, (time-$script_start_time);
669	foreach my $key (sort keys %stats) {
670	printf ", %d %s",$stats{$key},$key;
671	}
672	printf "\n";
673	}
674
675	######################################################################################################
676
677	sub get_station_close
678	{
679	my ($xmlid,$url) = @_;
680	&log("fetching (weekly) station close data for $xmlid");
681	my $data = Shepherd::Common::get_url(url => $url, debug => $debug);
682	my $tree = HTML::TreeBuilder->new_from_content($data) if ($data);
683
684	if (!defined $tree) {
685	&log("failed to fetch $url; skipping");
686	return;
687	}
688
689	my $daynum = 0;
690	my $last_td_text;
691
692	foreach my $tree_td ($tree->look_down('_tag' => 'td')) {
693	$daynum++ if ($tree_td->as_text() =~ /Morning\/Afternoon$/);
694	if ($tree_td->as_text() =~ /^\.\.\.programs start at /) {
695	if (defined $last_td_text) {
696	# 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
697	my @timeattr = localtime($starttime + (($daynum-1)*86400));
698	$timeattr[0] = 0; # zero seconds
699
700	if ($last_td_text =~ /^(\d+):(\d+)(.)m/) {
701	$timeattr[2] = $1; # hour
702	$timeattr[1] = $2; # min
703
704	if ($3 eq "p") {
705	# pm
706	$timeattr[2] += 12 if ($timeattr[2] != 12);
707	}
708	my $found_time = mktime(@timeattr);
709
710	if ($3 eq "a") {
711	# am - must be tomorrow
712	if ($timeattr[2] == 12) {
713	$found_time += (126060); # 12:xx am
714	} else {
715	$found_time += (246060);
716	}
717	}
718
719	$station_close_data->{$xmlid}->[$daynum] = $found_time;
720
721	printf "station close time for %s day %d is %s\n",
722	$xmlid, $daynum, POSIX::strftime("%Y%m%d%H%M", localtime($found_time))
723	if $debug;
724	}
725	}
726	}
727	$last_td_text = $tree_td->as_text();
728	}
729	$tree->delete;
730	}
731
732	######################################################################################################

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/abc_website @ 810

Download in other formats: