Context Navigation

ten_website

Revision 1271, 16.2 kB (checked in by max, 2 years ago)
ten_website: Source seems to be displaying wrong timestamps for non-EST
Property svn:executable set to ``*

Line
1	#!/usr/bin/perl -w
2
3	# network TEN au_tv guide grabber - runs from "Shepherd" master grabber
4	# * grabs data from the network TEN website (http://www.ten.com.au)
5	# for channel TEN only
6	# * this does NOT use any config file - all settings are passed in from shepherd
7
8	use strict;
9
10	my $progname = "ten_website";
11	my $version = "2.10";
12
13	use XMLTV;
14	use POSIX qw(strftime mktime);
15	use Getopt::Long;
16	use Data::Dumper;
17	use Shepherd::Common;
18	use XML::Simple;
19	use HTML::TreeBuilder;
20	use Data::Dumper;
21
22	#
23	# global variables and settings
24	#
25
26	$\| = 1;
27	my $script_start_time = time;
28	my %stats;
29	my $channels, my $opt_channels, my $gaps;
30	my $data_cache;
31	my $d;
32	my $opt;
33
34	my @supported_channels = ('TEN', 'One Digital', 'One HD', 'TEN HD');
35
36	#
37	# parse command line
38	#
39
40	$opt->{days} = 7; # default
41	$opt->{outputfile} = "output.xmltv"; # default
42	$opt->{cache_file} = $progname.".storable2.cache"; # default
43	$opt->{lang} = "en";
44	$opt->{region} = 94;
45
46	GetOptions(
47	'log-http' => \$opt->{log_http},
48	'region=i' => \$opt->{region},
49	'days=i' => \$opt->{days},
50	'offset=i' => \$opt->{offset},
51	'timezone=s' => \$opt->{timezone},
52	'channels_file=s' => \$opt->{channels_file},
53	'gaps_file=s' => \$opt->{gaps_file},
54	'output=s' => \$opt->{outputfile},
55	'cache-file=s' => \$opt->{cache_file},
56	'fast' => \$opt->{fast},
57	'no-cache' => \$opt->{no_cache},
58	'no-details' => \$opt->{no_details},
59	'debug+' => \$opt->{debug},
60	'warper' => \$opt->{warper},
61	'lang=s' => \$opt->{lang},
62	'no-hdtv-flags' => \$opt->{no_hdtv_flags},
63	'obfuscate' => \$opt->{obfuscate},
64
65	'help' => \$opt->{help},
66	'verbose' => \$opt->{help},
67	'version' => \$opt->{version},
68	'ready' => \$opt->{version},
69	'v' => \$opt->{help});
70
71	&help if ($opt->{help});
72
73	if ($opt->{version}) {
74	printf "%s %s\n",$progname,$version;
75	exit(0);
76	}
77
78	die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
79	$opt->{days} = 7 if ($opt->{days} > 7); # limit to a max of 7 days
80
81	# check XMLTV version for HDTV compatability
82	my @xmltv_version = split(/\./,$XMLTV::VERSION);
83	if (($xmltv_version[0] <= 0) && ($xmltv_version[1] <= "5") && ($xmltv_version[2] <= "43")) {
84	&log("XMLTV version ".$XMLTV::VERSION." too old to support HDTV flags. Disabling HDTV flags.");
85	$opt->{no_hdtv_flags} = 1;
86	$stats{disabled_hdtv_flag}++;
87	}
88
89	#
90	# go go go!
91	#
92
93	&log(sprintf "going to %sgrab %d days%s of data into %s (%s%s%s%s)",
94	(defined $opt->{gaps_file} ? "micro-gap " : ""),
95	$opt->{days},
96	(defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
97	$opt->{outputfile},
98	(defined $opt->{fast} ? "with haste" : "slowly"),
99	(defined $opt->{warper} ? ", anonymously" : ""),
100	(defined $opt->{no_details} ? ", without details" : ", with details"),
101	(defined $opt->{no_cache} ? ", without caching" : ", with caching"));
102
103	# normalize starttime to an hour..
104	my $starttime = time;
105	my $endtime = $starttime + ($opt->{days} * 86400);
106	$starttime += (86400 * $opt->{offset}) if (defined $opt->{offset});
107
108	# set defaults
109	Shepherd::Common::set_default("debug", (defined $opt->{debug} ? 2 : 0));
110	Shepherd::Common::set_default("webwarper", 1) if (defined $opt->{warper});
111	Shepherd::Common::set_default("squid", 1) if (defined $opt->{obfuscate});
112	Shepherd::Common::set_default("referer", "last");
113	Shepherd::Common::set_default("retry_delay", 10);
114	Shepherd::Common::setup_ua('cookie_jar' => 1, 'fake' => 1);
115
116	# read channels file
117	if (-r $opt->{channels_file}) {
118	local (@ARGV, $/) = ($opt->{channels_file});
119	no warnings 'all'; eval <>; die "$@" if $@;
120	} else {
121	die "WARNING: channels file $opt->{channels_file} could not be read\n";
122	}
123
124	foreach my $chan (keys %$channels)
125	{
126	unless (grep($chan eq $_, @supported_channels))
127	{
128	&log("Ignoring unsupported channel $chan.");
129	delete $channels->{$chan};
130	}
131	}
132	unless (keys %$channels)
133	{
134	&log("ERROR: No supported channels requested. Exiting.");
135	exit 22;
136	}
137
138	if (defined $opt->{gaps_file}) {
139	if (-r $opt->{gaps_file}) {
140	local (@ARGV, $/) = ($opt->{gaps_file});
141	no warnings 'all'; eval <>; die "$@" if $@;
142	} else {
143	die "WARNING: gaps file $opt->{gaps_file} could not be read: $!\n";
144	}
145
146	die "No supported channels in gaps lineup, nothing to do!" unless ($gaps and grep ($gaps->{$_}, @supported_channels));
147	}
148
149
150	&read_cache unless (defined $opt->{no_cache});
151
152	$stats{programmes} = 0;
153
154	foreach (keys %$channels)
155	{
156	&get_summary_page($_);
157	}
158
159	&get_detail_pages unless (defined $opt->{no_details});
160
161	&write_cache unless (defined $opt->{no_cache});
162
163	&write_xmltv;
164
165	&print_stats;
166	exit(0);
167
168	##############################################################################
169	# help
170
171	sub help
172	{
173	print<<EOF
174	$progname $version
175
176	options are as follows:
177	--help show these help options
178	--days=N fetch 'n' days of data (default: $opt->{days})
179	--output=file send xml output to file (default: "$opt->{outputfile}")
180	--no-cache don't use a cache to optimize (reduce) number of web queries
181	--no-details don't fetch detailed descriptions (default: do)
182	--no-hdtv-flags don't mark HD programs as being in HDTV (default: do)
183	--cache-file=file where to store cache (default "$opt->{cache_file}")
184	--fast don't run slow - get data as quick as you can - not recommended
185
186	--debug increase debug level
187	--warper fetch data using WebWarper web anonymizer service
188	--obfuscate pretend to be a proxy servicing multiple clients
189	--lang=[s] set language of xmltv output data (default $opt->{lang})
190
191	--region=N set region for where to collect data from (default: $opt->{region})
192	--channels_file=file where to get channel data from
193	--gaps_file=file micro-fetch gaps only
194
195	EOF
196	;
197
198	exit(0);
199	}
200
201	##############################################################################
202	# populate cache
203
204	sub read_cache
205	{
206	my $store = Shepherd::Common::read_cache(\$opt->{cache_file});
207
208	if ($store) {
209	$data_cache = $store->{data_cache};
210	}
211	}
212
213	##############################################################################
214	# write out updated cache
215
216	sub write_cache
217	{
218	# delete cache file from older OCR-based ten_website grabber
219	my $old_cache_file = $progname.".storable.cache";
220	unlink($old_cache_file) if (-f $old_cache_file);
221
222	# cleanup old entries from cache
223	for my $k (keys %{($data_cache->{prog_cache})}) {
224	if ($data_cache->{prog_cache}->{$k}->{last_used} < (time-(86400*14))) {
225	delete $data_cache->{prog_cache}->{$k};
226	$stats{expired_from_cache}++;
227	}
228	}
229
230	my $store;
231	$store->{data_cache} = $data_cache;
232	Shepherd::Common::write_cache($opt->{cache_file}, $store);
233	}
234
235	##############################################################################
236
237	sub log
238	{
239	my ($entry) = @_;
240	printf "%s\n",$entry;
241	}
242
243	##############################################################################
244
245	sub print_stats
246	{
247	printf "STATS: %s v%s completed in %d seconds",$progname, $version, time-$script_start_time;
248	foreach my $key (sort keys %stats) {
249	printf ", %d %s",$stats{$key},$key;
250	}
251	printf "\n";
252	}
253
254	##############################################################################
255
256	sub write_xmltv
257	{
258	my $writer;
259
260	my %writer_args = ( encoding => 'ISO-8859-1' );
261	if ($opt->{outputfile}) {
262	my $fh = new IO::File(">$opt->{outputfile}") \|\| die "can't open $opt->{outputfile}: $!";
263	$writer_args{OUTPUT} = $fh;
264	}
265
266	$writer = new XMLTV::Writer(%writer_args);
267
268	$writer->start
269	( { 'source-info-name' => "$progname $version",
270	'generator-info-name' => "$progname $version"} );
271
272	foreach my $chan (keys %$channels)
273	{
274	print "Writing channel $chan.\n";
275	$writer->write_channel( {'display-name' => [[ $chan, $opt->{lang} ]], 'id' => $channels->{$chan} } );
276	}
277
278	foreach my $prog (@{($d->{progs})}) {
279	delete $prog->{'link'};
280
281	Shepherd::Common::cleanup($prog);
282	# printf "DEBUG: programme xmltv: ".Dumper($prog) if (defined $opt->{debug});
283	printf "- %s (%s)\n", $prog->{title}->[0][0], $prog->{channel};
284	$writer->write_programme($prog);
285	}
286
287	$writer->end();
288	}
289
290	##############################################################################
291
292	sub get_summary_page
293	{
294	my $channel = shift;
295
296	my $state = Shepherd::Common::which_state($opt->{region});
297
298	my $reg = "sydney"; # sydney
299	$reg = "melbourne" if ($state eq "VIC"); # melbourne
300	$reg = "brisbane" if ($state eq "QLD"); # brisbane
301	$reg = "perth" if ($state eq "WA"); # perth
302	$reg = "adelaide" if ($state eq "SA"); # adelaide
303
304	&log("Fetching summary page ($channel $reg)");
305
306	my $url = sprintf "http://ten.com.au/tv-schedule/full?location=%s%s&uid=",
307	$reg,
308	$channel =~ /^One/ ? '&hd=1' : '';
309	my $tries = 5;
310	my ($data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts, $response) =
311	Shepherd::Common::get_url(url => $url, retries => ($tries-1));
312
313	$stats{failed_requests} += $failed_attempts;
314	$stats{slept_for} += $seconds_slept;
315	$stats{bytes_fetched} += $bytes_fetched;
316	my $prev_num_programmes = $stats{programmes};
317
318	if ((!$data) \|\| (!$success)) {
319	&log("Failed to fetch '$url' after $tries attempts.\nAborting: likely format change or blocked!");
320	exit(10);
321	}
322
323	$stats{http_successful_requests}++;
324
325	my $xml = new XML::Simple;
326	$data = $xml->XMLin($data);
327	foreach my $show (@{$data->{program}})
328	{
329	if (!$show->{startTime} or !$show->{endTime})
330	{
331	$stats{prog_bad_time}++;
332	next;
333	}
334	if (!$show->{program_name})
335	{
336	$stats{prog_no_title}++;
337	next;
338	}
339
340	# Alas, startTime and endTime fields appear to be
341	# incorrect for non-EST locations (as at 16-Jun-10).
342	#
343	#my $prog_start = substr($show->{startTime},0,10);
344	#my $prog_stop = substr($show->{endTime},0,10);
345
346	my @start_time_a = ( 0 );
347	$show->{'startDateText'} =~ /(\d+)-(\d+)-(\d+)/
348	and $start_time_a[5] = $1 - 1900
349	and $start_time_a[4] = $2 - 1
350	and $start_time_a[3] = $3;
351	$show->{'startTimeText'} =~ /(\d+):(\d+)(\w+)/
352	and $start_time_a[2] = ($3 eq 'AM' ? $1 : $1 + 12)
353	and $start_time_a[1] = $2;
354
355	my $prog_start = POSIX::mktime(@start_time_a);
356	my $prog_stop = $prog_start + ($show->{'duration'} * 60);
357
358	# only fetch within start/end times specified.
359	if (($prog_stop < $starttime) \|\| ($prog_start > $endtime))
360	{
361	$stats{prog_outside_window}++;
362	next;
363	}
364
365	# if microgap fetching only fetch within gaps
366	if (defined $opt->{gaps_file})
367	{
368	unless (&is_within_gaps($gaps->{$channel}, $prog_start, $prog_stop))
369	{
370	$stats{gaps_skipped}++;
371	next;
372	}
373	}
374
375	my $prog;
376	$prog->{channel} = $channels->{$channel};
377	$prog->{start} = POSIX::strftime("%Y%m%d%H%M", localtime($prog_start));
378	$prog->{stop} = POSIX::strftime("%Y%m%d%H%M", localtime($prog_stop));
379	$prog->{title} = [[ $show->{program_name}, $opt->{lang} ]];
380	$prog->{link} = $show->{link};
381	$prog->{link} =~ s/^\/tvguide_synopsis\.html\?id=//;
382
383	$d->{progs}->[$stats{programmes}] = $prog;
384	$stats{programmes}++;
385
386	&log(sprintf " %3d. %-40s (%s)", $stats{programmes}, $show->{program_name}, $prog->{start}) if ($opt->{debug});
387	}
388
389	&log(" summary returned data for ".($stats{programmes} - $prev_num_programmes)." programmes");
390	}
391
392	##############################################################################
393
394
395	# Use new URL which is heaps better for parsing & has great details:
396	#
397	# http://ten.com.au/feeds/$STATE/$URL
398	#
399	# ...where $STATE is one of qw( nsw vic qld sa wa )
400	# and $URL is the 'id' component of the guide 'link' field. (For example,
401	# 'Rugby_Spring_Tour_2008_2518335.xml'.)
402	#
403	# Interesting fields in main 'program' tag, set to '="true"' if they exist:
404	# repeat,close-captioned,high-definition,widescreen,live
405	#
406	sub get_detail_pages
407	{
408	my $prog_count;
409	$stats{used_detailed_cache} = 0;
410	&log("fetching up to ".$stats{programmes}." detail pages...");
411
412	my $state = lc(Shepherd::Common::which_state($opt->{region}));
413	for (my $i=0; $i < $stats{programmes}; $i++) {
414	my $url = $d->{progs}->[$i]->{link};
415	my $cache_key = $url
416	. ":" . $d->{progs}->[$i]->{title}[0][0]
417	. ":" . $d->{progs}->[$i]->{start}
418	. ":" . $d->{progs}->[$i]->{stop};
419	my $was_in_cache = 0;
420	$prog_count++;
421
422	# some descriptions all end up being the same. just skip fetching details on these
423	my @skip_these = qw( Home_Shopping Hillsong This_Is_Your_Day_With_Benny_Hinn Kenneth_Copeland \
424	Life_Today_With_James_Robison Christian_City_TV Toasted_TV );
425	my $id = $1 if $url =~ /^(.*)_\d+\.xml$/;
426	if (!$id or grep($id eq $_, @skip_these)) {
427	$stats{skipped_detail_pages}++;
428	next;
429	}
430
431	if (($prog_count % 10) == 1) {
432	&log(" .. at programme ".$prog_count." of ".$stats{programmes}." (".$stats{used_detailed_cache}." from cache)");
433	}
434
435	if (!defined $data_cache->{prog_cache}->{"$cache_key"}) {
436	my $fetch_url = "http://ten.com.au/feeds/$state/$url";
437	my $tries = 3;
438
439	&log("fetching prog ".$prog_count." [".$fetch_url."] ..") if (defined $opt->{debug} && $opt->{debug} > 1);
440
441	my ($data, $success, $status_msg, $bytes_fetched, $seconds_slept, $failed_attempts, $response) =
442	Shepherd::Common::get_url(url => $fetch_url, retries => ($tries-1));
443
444	$stats{failed_requests} += $failed_attempts;
445	$stats{slept_for} += $seconds_slept;
446	$stats{bytes_fetched} += $bytes_fetched;
447
448	if ((!$data) \|\| (!$success)) {
449	&log("Failed to fetch '$fetch_url' after $tries attempts. Has the format changed?");
450	$stats{bad_detail_response}++;
451
452	if ($stats{bad_detail_response} >= 3) {
453	&log($stats{bad_detail_response}." bad detailed responses. Disabling fetching details.");
454	return;
455	}
456
457	next;
458	}
459	$stats{http_successful_requests}++;
460
461	my $xml = new XML::Simple;
462	$data = $xml->XMLin($data);
463	my $prog = $data->{program};
464
465	print Dumper($data);
466
467	my $show = $d->{progs}->[$i];
468	my %type;
469	$show->{'title'} = [[ $prog->{'program_name'}, $opt->{lang} ]];
470	$show->{'sub-title'} = [[ $prog->{'episode_name'}, $opt->{lang} ]] unless (ref $prog->{'episode_name'});
471	$show->{video}->{aspect} = "16:9" if ($prog->{widescreen});
472	$show->{video}->{quality} = "HDTV" if ($prog->{'high-definition'});
473	$show->{'previously-shown'} = { } if ($prog->{repeat});
474	$show->{'desc'} = [[ $prog->{'synopsis'}, $opt->{lang} ]] unless (ref $prog->{'synopsis'});
475	$show->{'language'} = [ $prog->{'language'}, $opt->{lang} ] unless (ref $prog->{language});
476	$type{live} = 1 if ($prog->{'live'});
477	$type{series} = 1 if ($prog->{'program_type'} eq 'Series');
478	$type{movie} = 1 if ($prog->{'program_type'} eq 'Movie');
479	my $rating = $prog->{'classification'};
480	$rating .= sprintf " (%s)", $prog->{'consumer_advice'} unless (ref $prog->{'consumer_advice'});
481	$show->{'rating'} = [[ $rating, 'ABA', undef ]];
482
483
484	if ($prog->{actors} and !ref $prog->{actors})
485	{
486	$show->{credits}{actor} = [ split(/,/, $prog->{actors}) ];
487	}
488	if ($prog->{director} and !ref $prog->{director})
489	{
490	my @tmp = split(/,/, $prog->{director});
491	print "DIRECTOR: @tmp.\n";
492	$show->{credits}{director} = [ @tmp ] if (@tmp);
493	}
494	&Shepherd::Common::cleanup($show->{credits});
495
496	$show->{'country'} = [[ $prog->{'country'}, $opt->{lang} ]] unless (ref $prog->{'country'});
497	$show->{'date'} = $prog->{'prod_year'} unless (ref $prog->{'prod_year'});
498	$show->{'category'} = [ &Shepherd::Common::generate_category(
499	$show->{'title'}[0][0], $prog->{'hww_genre'}, %type) ];
500	$show->{'channel'} = $d->{progs}->[$i]->{'channel'};
501
502	$d->{progs}->[$i] = $show;
503	$data_cache->{prog_cache}->{"$cache_key"} = $show;
504	} else {
505	print "Using cache ($url).\n" if ($opt->{'debug'});
506	foreach (keys %{$data_cache->{prog_cache}->{$url}})
507	{
508	next if ($_ eq 'channel' or $_ eq 'last_used');
509	$d->{progs}->[$i]->{$_} = $data_cache->{prog_cache}->{"$cache_key"}->{$_};
510	}
511
512	$stats{used_detailed_cache}++;
513	$was_in_cache = 1;
514	}
515	$data_cache->{prog_cache}->{"$cache_key"}->{last_used} = time;
516
517	# printf "DEBUG: prog $i details: ".Dumper($d->{progs}->[$i]) if (defined $opt->{debug});
518
519	unless ($opt->{fast} or $was_in_cache)
520	{
521	my $sleep_for = int(rand(3));
522	sleep $sleep_for;
523	$stats{slept_for} += $sleep_for;
524	}
525	}
526	}
527
528
529	########################################################################
530	# Calculates whether a show's time window is within our wanted gaps.
531	#
532	# EG: next unless (&is_within_gaps($gaps->{'TEN'}, $start, $stop);
533	#
534	# Arguments:
535	# channel_gaps: relevent channel component of gaps file
536	# start: start time in epoch format
537	# stop: stop time in epoch format
538	#
539	sub is_within_gaps
540	{
541	my ($channel_gaps, $start, $stop) = @_;
542
543	foreach my $gap (@$channel_gaps)
544	{
545	if ($gap =~ /(\d+)-(\d+)/)
546	{
547	return 1 if ($stop > $1 and $start < $2);
548	}
549	}
550	return 0;
551	}
552

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/grabbers/ten_website

Download in other formats: