Context Navigation

abc_website @ 674

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/abc_website @ 674

Download in other formats: