Context Navigation

ninemsn

Revision 646, 37.7 kB (checked in by paul, 5 years ago)
apply my patches from #41
Property svn:executable set to ``*

Line
1	#!/usr/bin/perl -w
2
3	# ninemsn au_tv guide grabber - runs from "Shepherd" master grabber
4	# * grabs data from NineMSN (http://tvguide.ninemsn.com.au/)
5	# * this does NOT use any config file - all settings are passed in from shepherd
6	# * roughly based on Michael 'Immar' Smith's excellent original
7	# ninemsn tv_grab_au script but essentially rewritten
8
9	use strict;
10
11	my $progname = "ninemsn";
12	my $version = "0.15";
13
14	use LWP::UserAgent;
15	use XMLTV;
16	use POSIX qw(strftime mktime);
17	use Getopt::Long;
18	use HTML::TreeBuilder;
19	use Data::Dumper;
20	use JavaScript;
21	use Compress::Zlib;
22	use Storable;
23
24	#
25	# global variables and settings
26	#
27
28	$\| = 1;
29	my $script_start_time = time;
30	my %stats;
31	my $channels, my $opt_channels, my $gaps;
32	my $data_cache;
33	my $writer;
34	my $jsc;
35	my $ua;
36	my $prev_url;
37	my $d;
38	my $opt;
39
40	#
41	# parse command line
42	#
43
44	$opt->{days} = 7; # default
45	$opt->{outputfile} = "output.xmltv"; # default
46	$opt->{cache_file} = $progname.".storable.cache"; # default
47	$opt->{lang} = "en";
48	$opt->{region} = 94;
49
50	GetOptions(
51	'log-http' => \$opt->{log_http},
52	'region=i' => \$opt->{region},
53	'days=i' => \$opt->{days},
54	'offset=i' => \$opt->{offset},
55	'timezone=s' => \$opt->{timezone},
56	'channels_file=s' => \$opt->{channels_file},
57	'gaps_file=s' => \$opt->{gaps_file},
58	'output=s' => \$opt->{outputfile},
59	'cache-file=s' => \$opt->{cache_file},
60	'fast' => \$opt->{fast},
61	'no-cache' => \$opt->{no_cache},
62	'no-details' => \$opt->{no_details},
63	'debug+' => \$opt->{debug},
64	'warper' => \$opt->{warper},
65	'lang=s' => \$opt->{lang},
66	'obfuscate' => \$opt->{obfuscate},
67	'anonsocks=s' => \$opt->{anon_socks},
68	'scan-chan=s' => \$opt->{scan_chan},
69	'help' => \$opt->{help},
70	'verbose' => \$opt->{help},
71	'version' => \$opt->{version},
72	'ready' => \$opt->{version},
73	'v' => \$opt->{help});
74
75	&help if ($opt->{help});
76
77	&scan_channels if (defined $opt->{scan_chan});
78
79	if ($opt->{version}) {
80	printf "%s %s\n",$progname,$version;
81	exit(0);
82	}
83
84	die "no channel file specified, see --help for instructions\n", if (!$opt->{channels_file});
85	$opt->{days} = 7 if ($opt->{days} > 7); # limit to a max of 7 days
86
87	&log("WARNING: JavaScript version ".$JavaScript::VERSION." is too old. Please use at least version 0.55.")
88	if $JavaScript::VERSION < 0.55;
89
90
91	#
92	# go go go!
93	#
94
95	&log(sprintf "going to %sgrab %d days%s of data into %s (%s%s%s%s%s)",
96	(defined $opt->{gaps_file} ? "micro-gap " : ""),
97	$opt->{days},
98	(defined $opt->{offset} ? " (skipping first $opt->{offset} days)" : ""),
99	$opt->{outputfile},
100	(defined $opt->{fast} ? "with haste" : "slowly"),
101	(defined $opt->{anon_socks} ? ", via multiple endpoints" : ""),
102	(defined $opt->{warper} ? ", anonymously" : ""),
103	(defined $opt->{no_details} ? ", without details" : ", with details"),
104	(defined $opt->{no_cache} ? ", without caching" : ", with caching"));
105
106	# read channels file
107	if (-r $opt->{channels_file}) {
108	local (@ARGV, $/) = ($opt->{channels_file});
109	no warnings 'all'; eval <>; die "$@" if $@;
110	} else {
111	die "WARNING: channels file $opt->{channels_file} could not be read\n";
112	}
113
114	# if just filling in microgaps, parse gaps
115	if (defined $opt->{gaps_file}) {
116	if (-r $opt->{gaps_file}) {
117	local (@ARGV, $/) = ($opt->{gaps_file});
118	no warnings 'all'; eval <>; die "$@" if $@;
119	} else {
120	die "WARNING: gaps_file $opt->{gaps_file} could not be read: $!\n";
121	}
122	}
123
124	&read_cache unless (defined $opt->{no_cache});
125
126	&set_ua(1);
127	&setup_socks if (defined $opt->{anon_socks});
128
129	&setup_javascript;
130
131	&get_initial_page;
132
133	&start_writing_xmltv;
134
135	&get_daily_pages;
136	&get_detailed_pages;
137
138	&write_cache unless (defined $opt->{no_cache});
139	$writer->end();
140
141	&print_stats;
142	exit(0);
143
144	##############################################################################
145	# help
146
147	sub help
148	{
149	print<<EOF
150	$progname $version
151
152	options are as follows:
153	--help show these help options
154	--days=N fetch 'n' days of data (default: $opt->{days})
155	--output=file send xml output to file (default: "$opt->{outputfile}")
156	--no-cache don't use a cache to optimize (reduce) number of web queries
157	--no-details don't fetch detailed descriptions (default: do)
158	--cache-file=file where to store cache (default "$opt->{cache_file}")
159	--fast don't run slow - get data as quick as you can - not recommended
160	--debug increase debug level
161	--warper fetch data using WebWarper web anonymizer service
162	--obfuscate pretend to be a proxy servicing multiple clients
163	--anonsocks=(ip:port) use SOCKS4A server at (ip):(port) (for Tor: recommended)
164	--lang=[s] set language of xmltv output data (default $opt->{lang})
165
166	--region=N set region for where to collect data from (default: $opt->{region})
167	--channels_file=file where to get channel data from
168	--gaps_file=file micro-fetch gaps only
169
170	EOF
171	;
172
173	exit(0);
174	}
175
176	##############################################################################
177	# populate cache
178
179	sub read_cache
180	{
181	if (-r $opt->{cache_file}) {
182	my $store = Storable::retrieve($opt->{cache_file});
183	$data_cache = $store->{data_cache};
184	} else {
185	printf "WARNING: no programme cache $opt->{cache_file} - have to fetch all details\n";
186
187	# try to write to it - if directory doesn't exist this will then cause an error
188	&write_cache;
189	}
190	}
191
192	##############################################################################
193	# write out updated cache
194
195	sub write_cache
196	{
197	# cleanup old entries from cache
198	for my $cache_key (keys %{$data_cache}) {
199	my ($starttime, @rest) = split(/:/,$cache_key);
200	if ($starttime < (time-86400)) {
201	delete $data_cache->{$cache_key};
202	$stats{expired_from_cache}++;
203	}
204	}
205
206	my $store;
207	$store->{data_cache} = $data_cache;
208
209	Storable::store($store, $opt->{cache_file});
210	}
211
212	##############################################################################
213	# logic to fetch a page via http
214	# retries up to $retrycount times to get a page with 10 second pauses inbetween
215
216	sub get_url
217	{
218	my ($url,$retrycount,$referer,$reqtype,$postvars,$waittime) = @_;
219	my $request;
220	my $response;
221	my $attempts = 0;
222	my ($raw, $page, $base);
223
224	$reqtype = "GET" if (!defined $reqtype);
225	$waittime = 600 if (!defined $waittime);
226
227	$retrycount = 5 if ($retrycount == 0);
228	$url =~ s#^http://#http://webwarper.net/ww/# if (defined $opt->{warper});
229
230	if ($reqtype eq "GET") {
231	$request = HTTP::Request->new(GET => $url);
232	} elsif ($reqtype eq "POST") {
233	$request = HTTP::Request->new(POST => $url);
234	$request->add_content($postvars);
235	}
236
237	if (defined $referer) {
238	$request->header('Referer' => $referer);
239	printf "DEBUG: explicitly set Referer to '%s'\n", $referer if (defined $opt->{debug});
240	} else {
241	if (defined $prev_url) {
242	$request->header('Referer' => $prev_url);
243	printf "DEBUG: set Referer to '%s'\n", $prev_url if (defined $opt->{debug});
244	}
245	}
246	$prev_url = $url;
247
248	$request->header('Accept-Encoding' => 'gzip');
249
250	if ($opt->{obfuscate}) {
251	my $randomaddr = sprintf "203.%d.%d.%d",rand(255),rand(255),(rand(254)+1);
252	$request->header('Via' => '1.0 proxy:81 (Squid/2.3.STABLE3)');
253	$request->header('X-Forwarded-For' => $randomaddr);
254	}
255	for (1..$retrycount) {
256	$response = $ua->request($request);
257
258	if ((defined $opt->{log_http}) && (open(F,">>http_log.txt"))) {
259	printf F "\n----------------------------------------------------\n";
260	printf F "request: %s %s %s\n",$reqtype,$url,(defined $postvars ? $postvars : "");
261	printf F "referer: %s\n",$request->header('Referer');
262	printf F "response: %s\n",$response->status_line;
263	print F $response->content;
264	close F;
265	}
266
267	last if ($response->is_success);
268
269	$stats{http_failed_requests}++;
270	$attempts++;
271
272	$waittime = 10 if (defined $opt->{anon_socks});
273	&log("attempt $attempts of $retrycount failed to fetch $url, sleeping for $waittime seconds: ".$response->status_line);
274
275	unless ($attempts == $retrycount)
276	{
277	$stats{slept_for} += $waittime;
278	sleep $waittime;
279	}
280	}
281	if (!($response->is_success)) {
282	&log("aborting after $attempts attempts to fetch url $url");
283	return undef;
284	}
285
286	$prev_url = $response->base;
287	$prev_url =~ s#^http://webwarper.net/ww/#http://# if (defined $opt->{warper});
288	printf "DEBUG: set prev_url to '%s'\n", $prev_url if (defined $opt->{debug});
289
290	$stats{bytes_fetched} += do {use bytes; length($response->content)};
291	$stats{http_successful_requests}++;
292
293	if ((!$opt->{fast}) && (!defined $opt->{anon_socks})) {
294	my $sleeptimer = int(rand(5)) + 16; # sleep anywhere from 16 to 20 seconds
295	$stats{slept_for} += $sleeptimer;
296	sleep $sleeptimer;
297	}
298
299	if ($response->header('Content-Encoding') &&
300	$response->header('Content-Encoding') eq 'gzip') {
301	$stats{compressed_pages} += do {use bytes; length($response->content)};
302	$response->content(Compress::Zlib::memGunzip($response->content));
303	}
304	return $response->content;
305	}
306
307	##############################################################################
308	# turn a string into something that can be used on a URL line
309
310	sub urlify
311	{
312	my $str = shift;
313	$str =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
314	return $str;
315	}
316
317	##############################################################################
318
319	sub log
320	{
321	my ($entry) = @_;
322	printf "%s\n",$entry;
323	}
324
325	##############################################################################
326
327	sub print_stats
328	{
329	printf "STATS: %s v%s completed in %d seconds",$progname, $version, time-$script_start_time;
330	foreach my $key (sort keys %stats) {
331	printf ", %d %s",$stats{$key},$key;
332	}
333	printf "\n";
334	}
335
336	##############################################################################
337	# descend a structure and clean up various things, including stripping
338	# leading/trailing spaces in strings, translations of html stuff etc
339	# -- taken & modified from Michael 'Immir' Smith's excellent tv_grab_au
340
341	my %amp;
342	BEGIN { %amp = ( nbsp => ' ', qw{ amp & lt < gt > apos ' quot " } ) }
343
344	sub cleanup {
345	my $x = shift;
346	if (ref $x eq "REF") { cleanup($_) }
347	elsif (ref $x eq "HASH") { cleanup(\$_) for values %$x }
348	elsif (ref $x eq "ARRAY") { cleanup(\$_) for @$x }
349	elsif (defined $$x) {
350	$$x =~ s/&(#(\d+)\|(.*?));/ $2 ? chr($2) : $amp{$3}\|\|' ' /eg;
351	$$x =~ s/[^\x20-\x7f]/ /g;
352	$$x =~ s/(^\s+\|\s+$)//g;
353	}
354	}
355
356	##############################################################################
357
358	sub start_writing_xmltv
359	{
360	my %writer_args = ( encoding => 'ISO-8859-1' );
361	if ($opt->{outputfile}) {
362	my $fh = new IO::File(">$opt->{outputfile}") \|\| die "can't open $opt->{outputfile}: $!";
363	$writer_args{OUTPUT} = $fh;
364	}
365
366	$writer = new XMLTV::Writer(%writer_args);
367
368	$writer->start
369	( { 'source-info-name' => "$progname $version",
370	'generator-info-name' => "$progname $version"} );
371
372	for my $channel (sort keys %{$channels}) {
373	$writer->write_channel( {
374	'display-name' => [[ $channel, $opt->{lang} ]],
375	'id' => $channels->{$channel}
376	} );
377	}
378	}
379
380	##############################################################################
381
382	sub set_ua
383	{
384	my $enable_cookies = shift;
385
386	my @agent_list = (
387	'Mozilla/4.0 (compatible; MSIE 5.5; Windows 98)',
388	'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)',
389	'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; FunWebProducts)',
390	'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322)',
391	'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1; .NET CLR 1.1.4322; .NET CLR 2.0.50727)',
392	'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; Q312466)',
393	'Mozilla/4.0 (compatible; MSIE 6.0; Windows XP)',
394	'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/85.8.5 (KHTML, like Gecko) Safari/85.8.1',
395	'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.4) Gecko/20060508 Firefox/1.5.0.4',
396	'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.7.6) Gecko/20050512 Firefox',
397	'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.8) Gecko/20061025 Firefox/1.5.0.8',
398	'Mozilla/5.0 (Windows; U; Windows NT 5.1; de; rv:1.8.1) Gecko/20061010 Firefox/2.0',
399	'Mozilla/5.0 (compatible; Yahoo! Slurp; http://help.yahoo.com/help/us/ysearch/slurp)',
400	'Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-us) AppleWebKit/412 (KHTML, like Gecko) Safari/412',
401	'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; en-us) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
402	'Mozilla/5.0 (Macintosh; U; Intel Mac OS X; fr) AppleWebKit/418.9 (KHTML, like Gecko) Safari/419.3',
403	'Opera/9.00 (Windows NT 5.1; U; en)');
404
405	$ua = undef;
406	$ua = LWP::UserAgent->new('timeout' => 30, 'agent' => $agent_list[(int(rand($#agent_list+1)))] );
407	$ua->env_proxy;
408	$ua->cookie_jar({}) if (defined $enable_cookies);
409	$prev_url = undef; # reset referer
410	}
411
412	##############################################################################
413	# 1.
414	# browse to http://tvguide.ninemsn.com.au/ via
415	# http://tvguide.ninemsn.com.au/setlocation.asp?region=<reg>&returnURL=http://tvguide.ninemsn.com.au/
416	# and soak up the "day" URLs
417
418	sub get_initial_page
419	{
420	my $returl = "http://tvguide.ninemsn.com.au/";
421	my $url = "http://tvguide.ninemsn.com.au/setlocation.asp?region=".$opt->{region}."&returnURL=$returl";
422
423	&log("setting location via $url");
424	my $data = &get_url($url, 5, $returl, "GET", undef, 30);
425
426	if (!$data) {
427	&log("CRITIAL ERROR: ABORTING: could not read initial page '$url'");
428	exit(1);
429	}
430
431	# parse initial page
432	my $tree = HTML::TreeBuilder->new_from_content($data);
433	if (!$tree) {
434	&log("CRITICAL ERROR: ABORTING: could not build tree from data in '$url'");
435	exit(1);
436	}
437
438	# find <select name=day..> tag
439	my $select_day_tag = $tree->look_down('_tag' => 'select', 'name' => 'day');
440	if (!$select_day_tag) {
441	&log("CRITICAL ERROR: ABORTING: could not find a day tag in '$url'");
442	exit(1);
443	}
444
445	# take note of options
446	my $found_options = 0;
447
448	foreach my $opt_tag ($select_day_tag->look_down('_tag' => 'option')) {
449	push (@{($d->{day_values})},$opt_tag->attr('value'));
450	$found_options++;
451
452	printf "DEBUG: day %d tag is '%s'\n",$found_options,$opt_tag->attr('value')
453	if (defined $opt->{debug});
454	}
455
456	if ($found_options == 0) {
457	&log("CRITICAL ERROR: ABORTING: could not find any day tag options in '$url'");
458	exit(1);
459	}
460	}
461
462	##############################################################################
463	# get daily pages
464
465	sub get_daily_pages
466	{
467	my $starttime = time;
468	my $day_num = 0;
469	my $skip_days = 0;
470
471	$skip_days = $opt->{offset} if (defined $opt->{offset});
472
473	foreach my $day_opt (@{($d->{day_values})}) {
474	my $currtime = $starttime + (606024 * $day_num);
475	$day_num++;
476
477	return if ($day_num > $opt->{days});
478
479	# skip if --offset applies against this day
480	if ($skip_days > 0) {
481	$skip_days--;
482	next;
483	}
484
485	my @timeattr = localtime($currtime); # 0=sec,1=min,2=hour,3=day,4=month,5=year,6=wday,7=yday,8=isdst
486	$timeattr[0] = 0; # zero sec
487	$timeattr[1] = 0; # zero min
488	$timeattr[2] = 0; # zero hour
489	my $day_start = mktime(@timeattr); # midnight on the day
490
491	&parse_daily_page($day_opt,$day_start,$day_num);
492	}
493	}
494
495	##############################################################################
496	# parse a daily page
497
498	sub parse_daily_page
499	{
500	my ($day_opt,$day_start,$day_num) = @_;
501
502	my $url = "http://tvguide.ninemsn.com.au/todaytv/default.asp";
503	my $postvars = "channel=free&day=".urlify($day_opt)."&go=go";
504
505	my $progs_in_day = 0;
506
507	my $tries = 0;
508	my $tree;
509	while ((!$tree) && ($tries < 10)) {
510	$tries++;
511	&log("fetching day $day_num summary page (try $tries): POST $url $postvars");
512
513	# my $data = &get_url($url, 1, undef, "POST", $postvars);
514	my $data = &get_url($url."?".$postvars, 1, undef);
515	$tree = HTML::TreeBuilder->new_from_content($data) if ($data);
516	}
517
518	if (!$tree) {
519	&log("WARNING: skipping day $day_num: could not fetch '$url' afer 5 attempts: format/URL changed?");
520	return 0;
521	}
522
523	my $table_tag = $tree->look_down('_tag' => 'table', 'class' => 'tv');
524	if (!$table_tag) {
525	&log("WARNING: skipping day $day_num: could not find tv table in '$url': has the format changed?");
526	return 0;
527	}
528
529	my $row_num = 0;
530	my @row_span; # used to track rowspan= counts
531	my @chan_col;
532	my $max_cols;
533
534	foreach my $tree_tr ($table_tag->look_down('_tag' => 'tr')) {
535	if ($row_num == 0) {
536	#
537	# parse channels
538	#
539
540	my $col_num = 0;
541	foreach my $tree_td ($tree_tr->look_down('_tag' => 'td')) {
542	my $ch = translate_channel_name($tree_td->as_text());
543
544	if (defined $channels->{$ch}) {
545	$chan_col[$col_num] = $channels->{$ch};
546
547	printf "DEBUG: chan_map col %d '%s' -> %s\n", $col_num, $ch,
548	(defined $chan_col[$col_num] ? $chan_col[$col_num] : "(undef)")
549	if (defined $opt->{debug});
550	} else {
551	if (!defined $d->{unknown_chan}->{$ch}) {
552	&log("Ignoring programmes from unknown channel '$ch'");
553	$d->{unknown_chan}->{$ch} = 1; # so we report this only once
554	}
555	}
556
557	$row_span[$col_num] = 1; # set initial row_span to 1
558	$col_num++;
559	}
560	$max_cols = $col_num;
561	printf "DEBUG: set max_cols to $max_cols\n" if (defined $opt->{debug});
562	} else {
563	#
564	# parse programmes
565	#
566
567	my $col_num = -1;
568	foreach my $tree_td ($tree_tr->look_down('_tag' => 'td', 'class' => 'tv')) {
569	$col_num++; # increment at beginning - just easier
570
571	my $prog;
572	my $prog_name = $tree_td->as_text();
573
574	# calculate programme starttime, either based on row number
575	# (each row = 5 mins) or an explicit start time in the prog_name
576	if ($prog_name =~ s/\s\[\s (\d+):(\d+) \s* (am\|pm) \s\]\s //x) {
577	my ($hr, $min, $ampm) = ($1, $2, lc($3));
578	$hr = 0 if ($hr == 12);
579	$hr += 12 if ($ampm eq "pm");
580	$hr += 24 if (($ampm eq "am") && ($hr < 6));
581
582	$prog->{starttime} = $day_start + ((6060)$hr) + (60*$min);
583
584	printf "DEBUG: starttime of prog '%s' explicitly set to %s\n",
585	$prog_name, (strftime "%Y%m%d%H%M", localtime($prog->{starttime}))
586	if (defined $opt->{debug});
587	} else {
588	$prog->{starttime} = $day_start + ((6060)6) + ((560)($row_num-1));
589
590	printf "DEBUG: starttime of prog '%s' calculated to be %s based on row %d\n",
591	$prog_name, (strftime "%Y%m%d%H%M", localtime($prog->{starttime})),
592	$row_num, if (defined $opt->{debug});
593	}
594
595	# got a cell. work out what column it applies to,
596	# taking into account any rowspans that are going on
597	while (($col_num < $max_cols) && ($row_span[$col_num] > 1)) {
598	printf "DEBUG: row %d column %d skipped due to rowspan (%d)\n",
599	$row_num, $col_num, $row_span[$col_num] if (defined $opt->{debug});
600
601	$row_span[$col_num]--; # decrease span
602	$col_num++; # jump to next column
603	}
604
605	if ($col_num == $max_cols) {
606	# no longer in a valid column!
607	&log("WARNING: Bad HTML (excess columns) in row $row_num of '$url': celltext: '$prog_name'. Format changed?");
608	next;
609	}
610
611	# set (future) rowspan
612	if ($tree_td->attr('rowspan')) {
613	my $found_span = $tree_td->attr('rowspan');
614
615	if ($found_span =~ /^(\d+)$/) {
616	$row_span[$col_num] = $found_span;
617	} else {
618	# a BOGUS span - invalid HTML - who would have thought?!???
619	printf "DEBUG: ignored a non-numeric rowspan in row %d column %d: '%s': skipped\n",
620	$row_num, $col_num, $found_span if (defined $opt->{debug});
621	next;
622	}
623	}
624
625	# programme length is based on number of rows spanned
626	$prog->{stoptime} = $prog->{starttime} + ((560)$row_span[$col_num]);
627
628	my $prog_a = $tree_td->look_down('_tag' => 'a');
629	$prog->{url} = $prog_a->attr('href') if ($prog_a);
630
631	if (!defined $prog->{url}) {
632	# no url - not a programme?
633	&log("WARNING: Bad HTML (no link) in row $row_num column $col_num of '$url': '$prog_name' has no URL. Format changed?");
634	next;
635	}
636
637	if (!defined $chan_col[$col_num]) {
638	# no channel for this programme!
639	printf "DEBUG: Programme in row $row_num column $col_num had no known channel! ($prog_name)\n"
640	if (defined $opt->{debug});
641	$stats{skipped_prog_no_channel}++;
642	next;
643	}
644	$prog->{channel} = $chan_col[$col_num];
645	$prog->{title} = [[ $prog_name, $opt->{lang} ]];
646	$progs_in_day++;
647
648	# if we are fetching microgaps, skip if this isn't
649	# in a micro-gap.
650	if (defined $opt->{gaps_file}) {
651	my $found_gap_match = 0;
652	if (defined $gaps->{$chan_col[$col_num]}) {
653	foreach my $g (@{($gaps->{$chan_col[$col_num]})}) {
654	my ($s, $e) = split(/-/,$g);
655	$found_gap_match = 1 if
656	((($s >= $prog->{starttime}) && ($s <= $prog->{stoptime})) \|\|
657	(($e >= $prog->{starttime}) && ($e <= $prog->{stoptime})) \|\|
658	(($s <= $prog->{starttime}) && ($e >= $prog->{stoptime})));
659	}
660	}
661	if (!$found_gap_match) {
662	$stats{gaps_skipped}++;
663	next;
664	} else {
665	$stats{gaps_included}++;
666	}
667	}
668
669	#
670	# got programme, store it for grabbing detailed info in next step
671	#
672
673	$stats{programmes}++;
674	push(@{($d->{progs})},$prog);
675	}
676
677	# update any remaining rowspan counters
678	$col_num++;
679	while (($col_num < $max_cols) && ($row_span[$col_num] > 1)) {
680	printf "DEBUG: blank row %d: decreasing column %d rowspan (%d)\n",
681	$row_num, $col_num, $row_span[$col_num] if (defined $opt->{debug});
682
683	$row_span[$col_num]--; # decrease span
684	$col_num++; # jump to next column
685	}
686	}
687
688	$row_num++;
689	}
690
691	&log("WARNING: $progs_in_day programmes seen for day $day_num. URL/formatting changed? (url $url)")
692	if ($progs_in_day < 50);
693	}
694
695	##############################################################################
696	# loop through our progs, fetching details where we don't have a pre-cached
697	# entry for them.
698	# write out XMLTV
699
700	sub get_detailed_pages
701	{
702	my $prog_count = 0;
703	my $added_to_cache = 0;
704
705	&set_ua;
706
707	foreach my $prog (@{($d->{progs})}) {
708	$prog_count++;
709	my $cache_key = sprintf "%d:%s:%s", $prog->{starttime}, $prog->{channel}, $prog->{title}->[0]->[0];
710
711	if ((!defined $data_cache->{$cache_key}) && (!defined $opt->{no_details}) &&
712	($prog->{title}->[0]->[0] ne "Station Close")) {
713	printf "DEBUG: Fetching detail page: %s: %s\n",
714	$prog->{channel}, $prog->{url} if (defined $opt->{debug});
715
716	# not in cache, go fetch additional details if we can
717	&fetch_one_prog($cache_key, $prog->{url}, $prog_count, $stats{programmes});
718	$stats{added_to_cache}++;
719	&write_cache if ((($stats{added_to_cache} % 5) == 0) && (!defined $opt->{no_cache}));
720	} elsif (!defined $opt->{no_details}) {
721	$stats{used_existing_cache_entry}++;
722	}
723
724	# if we got additional details, add them now
725	if (defined $data_cache->{$cache_key}) {
726	foreach my $key (keys %{($data_cache->{$cache_key})}) {
727	$prog->{$key} = $data_cache->{$cache_key}->{$key};
728	}
729	}
730
731	# if we now have a length field, use that as a more accurate
732	# stop time (we may have got a length field in the detailed data)
733	$prog->{stop} = $prog->{start} + (60*$prog->{length})
734	if (defined $prog->{length});
735
736	# convert epoch starttime into XMLTV starttime
737	$prog->{start} = strftime "%Y%m%d%H%M", localtime($prog->{starttime});
738	delete $prog->{starttime};
739
740	# convert epoch stoptime into XMLTV stoptime
741	$prog->{stop} = strftime "%Y%m%d%H%M", localtime($prog->{stoptime});
742	delete $prog->{stoptime};
743
744	delete $prog->{url};
745	&cleanup($prog);
746
747	printf "DEBUG: programme xmltv: ".Dumper($prog) if (defined $opt->{debug});
748	$writer->write_programme($prog);
749	}
750	}
751
752	##############################################################################
753	# fetch detailed info on one prog
754
755	sub fetch_one_prog
756	{
757	my ($cache_key,$url,$prog_count,$total_prog_count) = @_;
758
759	$url = "http://tvguide.ninemsn.com.au".$url if ($url !~ /^http/);
760	$url =~ s/\/closeup\//\/cu\//;
761
762	my $sleep_for = 600;
763	$sleep_for = 10 if (defined $opt->{anon_socks});
764
765	my $tries = 0;
766	my $data;
767	my $parsed_text = "";
768	while ((!$data) && ($tries < 12)) {
769	$tries++;
770	&log("fetching programme detail page ($prog_count of $total_prog_count) [try $tries]");
771	$data = &get_url($url, 1);
772
773	if ($data) {
774	$data =~ s{<script language="?Javascript"?[^>]>(.?)</script>}{
775	my $x = $1;
776	$jsc->eval(qq{ doc = '' });
777	$jsc->eval($x);
778	$parsed_text .= $jsc->eval(qq{ doc }) \|\| '';
779	}isge;
780
781	if ($data =~ /we are unable/i) {
782	&log("got unable page, sleeping for $sleep_for seconds");
783	sleep $sleep_for;
784	$stats{slept_for} += $sleep_for;
785	&set_ua;
786	$data = undef;
787	}
788	} else {
789	&log("failed, sleeping for $sleep_for seconds");
790	sleep $sleep_for;
791	$stats{slept_for} += $sleep_for;
792	&set_ua;
793	# &get_initial_page;
794	}
795	}
796
797	if (!$data) {
798	&log("WARNING: skipping programme, could not fetch '$url' afer 12 attempts: format/URL changed?");
799	return;
800	}
801
802	if ($parsed_text eq "") {
803	&log("WARNING: skipping programme, could not find javascript to execute in '$url': format changed?");
804	return;
805	}
806
807	# split HTML up into sections seperated by <BR><BR>
808	my @html_lines = split(/<BR><BR>/,$parsed_text);
809	&cleanup(@html_lines);
810
811	# line 1 contains progname, duration and genre
812	$html_lines[0] =~ s/<.*?>//g; # note: can fail on complex tags
813	if ($html_lines[0] =~ /\((\d+) mins/) {
814	$data_cache->{$cache_key}->{length} = $1;
815	printf "DEBUG: set 'length' to '%d'\n",$1 if (defined $opt->{debug});
816	}
817	if ($html_lines[0] =~ /Rated: ([^\)]+)\)/) {
818	my @ratings;
819	push(@ratings, [$1, 'ABA', undef]);
820	$data_cache->{$cache_key}->{rating} = [ @ratings ];
821	printf "DEBUG: set 'rating' to '%s'\n",$1 if (defined $opt->{debug});
822	}
823	if ($html_lines[0] =~ /Genre: (.*)$/) {
824	my $cat = translate_category($1);
825	my @categories;
826	push(@categories,$cat,$opt->{lang});
827	$data_cache->{$cache_key}->{category} = [[ @categories ]];
828	printf "DEBUG: set 'category' to '%s'\n",$cat if (defined $opt->{debug});
829	}
830
831	# line 2 contains description
832	if ($html_lines[1] ne "") {
833	$data_cache->{$cache_key}->{desc} = [[ $html_lines[1], $opt->{lang} ]];
834	printf "DEBUG: set desc to '%s'\n",$html_lines[1] if (defined $opt->{debug});
835	}
836	}
837
838	##############################################################################
839
840	sub setup_javascript
841	{
842	$jsc = new JavaScript::Runtime->create_context();
843	$jsc->set_error_handler( sub { } );
844
845	$jsc->eval(qq{
846	var doc = '';
847	function Location() { this.href = 'http://ninemsn.com.au'; }
848	function Document() { this.write = function(x) { doc += x; } }
849	function Window() { this.___ww = 0 }
850
851	location = new Location;
852	document = new Document;
853	window = new Window;
854	});
855	}
856
857	##############################################################################
858
859	sub translate_category
860	{
861	my $genre = shift;
862	my %translation = (
863	'Sport' => 'sports',
864	'Soap Opera' => 'Soap',
865	'Science and Technology' => 'Science/Nature',
866	'Real Life' => 'Reality',
867	'Cartoon' => 'Animation',
868	'Family' => 'Children',
869	'Murder' => 'Crime' );
870
871	return $translation{$genre} if defined $translation{$genre};
872	return $genre;
873	}
874
875
876	##############################################################################
877
878	sub setup_socks
879	{
880	use LWP::Protocol::http;
881	my $orig_new_socket = \&LWP::Protocol::http::_new_socket;
882
883	# override LWP::Protocol::http's _new_socket method with our own
884	local($^W) = 0;
885	*LWP::Protocol::http::_new_socket = \&socks_new_socket;
886
887	# test that it works
888	&log("configured to use Tor, testing that it works by connecting to www.google.com ...");
889	my $data = &get_url("http://www.google.com/",10);
890	if (($data) && ($data =~ /Google/i)) {
891	&log("success. Tor appears to be working!");
892	return;
893	}
894
895	&log("ERROR: Could not connect to www.google.com via Tor, disabling Tor.");
896	&log(" DATA FETCHING WILL BE VERY SLOW.");
897	&log(" DISABLING DETAILS-FETCHING BECAUSE OF THIS - SIGNIFICANTLY LOWER DATA QUALITY!!");
898
899	$opt->{no_details} = 1;
900	delete $opt->{anon_socks};
901	$stats{fallback_to_non_tor}++;
902
903	*LWP::Protocol::http::_new_socket = $orig_new_socket;
904	}
905
906	##############################################################################
907	# our own SOCKS4Aified version of LWP::Protocol::http::_new_socket
908
909	sub socks_new_socket
910	{
911	my($self, $host, $port, $timeout) = @_;
912
913	my ($socks_ip,$socks_port) = split(/:/,$opt->{anon_socks});
914	$socks_ip = "127.0.0.1" if (!defined $socks_ip);
915	$socks_port = "9050" if (!defined $socks_port);
916
917	local($^W) = 0; # IO::Socket::INET can be noisy
918	my $sock = $self->socket_class->new(
919	PeerAddr => $socks_ip,
920	PeerPort => $socks_port,
921	Proto => 'tcp');
922
923	unless ($sock) {
924	# IO::Socket::INET leaves additional error messages in $@
925	$@ =~ s/^.*?: //;
926	&log("Can't connect to $host:$port ($@)");
927	return undef;
928	}
929
930	# perl 5.005's IO::Socket does not have the blocking method.
931	eval { $sock->blocking(0); };
932
933	# establish connectivity with socks server - SOCKS4A protocol
934	print { $sock } pack("CCnN", 0x04, 0x01, $port, 1) .
935	(pack 'x') .
936	$host . (pack 'x');
937
938	my $received = "";
939	my $timeout_time = time + $timeout;
940	while ($sock->sysread($received, 8) && (length($received) < 8) ) {
941	select(undef, undef, undef, 0.25);
942	last if ($timeout_time < time);
943	}
944
945	if ($timeout_time < time) {
946	&log("Timeout ($timeout) while connecting via SOCKS server");
947	return $sock;
948	}
949
950	my ($null_byte, $req_status, $port_num, $ip_addr) = unpack('CCnN',$received);
951	&log("Connection via SOCKS4A server rejected or failed") if ($req_status == 0x5b);
952	&log("Connection via SOCKS4A server because client is not running identd") if ($req_status == 0x5c);
953	&log("Connection via SOCKS4A server because client's identd could not confirm the user") if ($req_status == 0x5d);
954
955	$sock;
956	}
957
958	##############################################################################
959
960	sub scan_channels
961	{
962	my %REGIONS = (
963	126 => "ACT", 73 => "NSW: Sydney", 184 => "NSW: Newcastle",
964	66 => "NSW: Central Coast", 67 => "NSW: Griffith", 63 => "NSW: Broken Hill",
965	69 => "NSW: Northern NSW", 71 => "NSW: Southern NSW", 106 => "NSW: Remote and Central",
966	74 => "NT: Darwin", 108 => "NT: Remote & Central", 75 => "QLD: Brisbane",
967	78 => "QLD: Gold Coast", 79 => "QLD: Regional", 114 => "QLD: Remote & Central",
968	81 => "SA: Adelaide", 82 => "SA: Renmark", 83 => "SA: Riverland",
969	85 => "SA: South East SA", 86 => "SA: Spencer Gulf", 107 => "SA: Remote & Central",
970	88 => "Tasmania", 94 => "VIC: Melbourne", 93 => "VIC: Geelong",
971	90 => "VIC: Eastern Victoria", 95 => "VIC: Mildura/Sunraysia", 98 => "VIC: Western Victoria",
972	101 => "WA: Perth", 102 => "WA: Regional");
973
974	&set_ua(1);
975	&setup_socks if (defined $opt->{anon_socks});
976	&setup_javascript;
977
978	my $now = time;
979
980	printf "\nScanning channels:\n\n";
981
982	foreach my $r (sort { $a <=> $b } keys %REGIONS) {
983	next if (($opt->{scan_chan} ne "all") && ($opt->{scan_chan} ne $r));
984
985	printf "Looking up region %d (%s) ..\n",$r, $REGIONS{$r};
986
987	#
988	# 1. get shepherd channels
989	#
990	my $ua2 = LWP::UserAgent->new();
991	$ua2->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
992	$ua2->cookie_jar({});
993	$ua2->get('http://www.yourtv.com.au');
994	my $response = $ua2->get('http://www.yourtv.com.au/profile/ajax.cfm?action=channels&region_id='.$r);
995	my $page = $response->content;
996	if ($response->is_error()) {
997	printf "Unable to download channel list for region $r from YourTV\n";
998	next;
999	}
1000
1001	# shepherd rules for station names
1002	my (%shepherd_channels, $clist, $cn, $rq);
1003	while ($page =~ /<label for="venue_id.?>(.?)<\/label>/sg) {
1004	my $channel = $1;
1005	$channel =~ s/\s{2,}//g;
1006	if ($channel =~ /(.) ($.$)/) {
1007	($cn, $rq) = ($1, $2);
1008	} else {
1009	($cn, $rq) = ($channel, "");
1010	}
1011
1012	if ($clist->{$cn}) { # Is there already a channel with this name?
1013	$clist->{$cn} = [ "(".$REGIONS{$r}.")" ] if (@{$clist->{$cn}} == 1 and $clist->{$cn}[0] eq '');
1014	$rq = $REGIONS{$r} if ($rq eq '');
1015	die "Bad channel list in region $r!" if (grep($rq eq $_, @{$clist->{$cn}}));
1016	push @{$clist->{$cn}}, $rq;
1017	} else {
1018	$clist->{$cn} = [ $rq ];
1019	}
1020	}
1021
1022	foreach $cn (keys %$clist) {
1023	if (@{$clist->{$cn}} == 1) {
1024	$shepherd_channels{$cn} = 1;
1025	} else {
1026	foreach $rq (@{$clist->{$cn}}) {
1027	$shepherd_channels{"$cn $rq"} = 1;
1028	}
1029	}
1030	}
1031
1032
1033	#
1034	# 2. get ninemsn channels
1035	#
1036	$opt->{region} = $r;
1037	delete $d->{day_values};
1038
1039	&set_ua(1);
1040	&get_initial_page;
1041
1042	my $url = "http://tvguide.ninemsn.com.au/todaytv/default.asp";
1043	my $postvars = "channel=free&day=".urlify(splice(@{($d->{day_values})},0,1))."&go=go";
1044
1045	my $tries = 0;
1046	my $tree;
1047	while ((!$tree) && ($tries < 10)) {
1048	$tries++;
1049	my $data = &get_url($url."?".$postvars, 1, undef);
1050	$tree = HTML::TreeBuilder->new_from_content($data) if ($data);
1051	}
1052	if (!$tree) {
1053	printf "WARNING: skipping region $r, couldn't fetch '$url' afer 10 attempts";
1054	next;
1055	}
1056
1057	my $table_tag = $tree->look_down('_tag' => 'table', 'class' => 'tv');
1058	if (!$table_tag) {
1059	printf "WARNING: skipping region $r, couldn't find tv table in '$url': has the format changed?";
1060	next;
1061	}
1062
1063	my %seen_ch;
1064	my $tree_tr = $table_tag->look_down('_tag' => 'tr');
1065	foreach my $tree_td ($tree_tr->look_down('_tag' => 'td')) {
1066	my $channel = translate_channel_name($tree_td->as_text());
1067
1068	if (!defined $shepherd_channels{$channel}) {
1069	$shepherd_channels{$channel} = 0; # shepherd doesn't know about this channel, ninemsn does
1070	} elsif ($shepherd_channels{$channel} == 1) {
1071	$shepherd_channels{$channel} = 2; # both shepherd & ninemsn know about channel
1072	} elsif ($shepherd_channels{$channel} == 2) {
1073	$shepherd_channels{$channel} = 3; # shepherd/ninemsn knew about channel but was duplicated!
1074	} elsif ($shepherd_channels{$channel} == 0) {
1075	; # aiee. a duplicate of a channel that shepherd doesn't know about!
1076	} else {
1077	die "unhandled shepherd_channels case for '$channel' value ".$shepherd_channels{$channel};
1078	}
1079
1080	printf " %35s %s%s%s\n",
1081	$channel,
1082	(defined $seen_ch{$channel} ? "\t[Duplicate in ninemsn]" : ""),
1083	($shepherd_channels{$channel} == 0 ? "\t[Only known to ninemsn]" : ""),
1084	($shepherd_channels{$channel} == 2 ? "\t[Known to both ninemsn/Shepherd (good!)]" : ""),
1085	($shepherd_channels{$channel} == 3 ? "\t[Known to both ninemsn/Shepherd but duplicate in ninemsn]" : "");
1086
1087	$seen_ch{$channel}++;
1088	}
1089
1090	# any channels in Shepherd that ninemsn didn't return?
1091	foreach my $ch (keys %shepherd_channels) {
1092	printf " %35s\t[Only known to Shepherd]\n",$ch if ($shepherd_channels{$ch} == 1);
1093	}
1094
1095	printf "\n";
1096	}
1097
1098	exit(0);
1099	}
1100
1101	##############################################################################
1102
1103	sub translate_channel_name
1104	{
1105	my $ch = shift;
1106	return $ch if (defined $channels->{$ch});
1107
1108	# generic remapping
1109	if ($ch =~ /^ABC\s/) {
1110	$ch = "ABC";
1111	} elsif (($ch =~ /^SBS/) && ($ch !~ /news/i)) {
1112	$ch = "SBS";
1113	} elsif ($ch =~ /^SBS News/i) {
1114	$ch = "SBS News";
1115	} elsif ($ch =~ /^CENTRAL\s(.*)$/) {
1116	$ch = "Central $1";
1117	} elsif ($ch =~ /^SOUTHERN CROSS\s(.*)$/) {
1118	$ch = "Sthn Cross $1";
1119	}
1120	return $ch if (defined $channels->{$ch});
1121
1122	# more specific remapping
1123	if ($ch =~ /^CHANNEL NINE [A-Z]+$/) {
1124	$ch = "Nine";
1125	} elsif ($ch =~ /^CHANNEL SEVEN [A-Z]+$/) {
1126	$ch = "Seven";
1127	} elsif ($ch =~ /^NETWORK TEN [A-Z]+$/) {
1128	$ch = "TEN";
1129	} elsif ($ch =~ /^PRIME [A-Z]+$/) {
1130	$ch = "Prime";
1131	} elsif ($ch =~ /^Sthn Cross [A-Z]+$/) {
1132	$ch = "Southern Cross";
1133	} elsif ($ch =~ /^WIN TELEVISION [A-Z]+$/) {
1134	$ch = "WIN";
1135	} elsif ($ch =~ /^IMPARJA TELEVISION/) {
1136	$ch = "Imparja";
1137	}
1138	return $ch if (defined $channels->{$ch});
1139
1140	# very specific channel mapping when the above generic ones don't match
1141	if ($opt->{region} == 63) {
1142	return "Sthn Cross TEN" if ($ch eq "Southern Cross");
1143	} elsif ($opt->{region} == 66) {
1144	return "Prime" if ($ch eq "PRIME NORTHERN, NEWCASTLE");
1145	return "Sthn Cross TEN" if ($ch eq "Sthn Cross TEN NORTHERN NSW, NON GOLD COAST");
1146	} elsif ($opt->{region} == 67) {
1147	return "TEN" if ($ch eq "Sthn Cross TEN CAPITAL, WAGGA");
1148	} elsif ($opt->{region} == 69) {
1149	return "Prime" if ($ch eq "PRIME NORTHERN, TAMWORTH/TAREE/LISMORE/COFFS HARBOUR");
1150	return "Sthn Cross TEN" if ($ch eq "Sthn Cross TEN NORTHERN NSW, NON GOLD COAST");
1151	} elsif ($opt->{region} == 71) {
1152	return "TEN (Mildura Digital)" if ($ch eq "NETWORK TEN DIGITAL, MILDURA");
1153	return "Prime (Canberra/Wollongong/South Coast)" if ($ch eq "PRIME SOUTHERN, CANBERRA/WOLLONGONG/STH COAST");
1154	return "Prime (Wagga Wagga/Orange)" if ($ch eq "PRIME SOUTHERN, WAGGA WAGGA/ORANGE");
1155	return "TEN (NSW: Southern NSW)" if ($ch eq "Sthn Cross TEN CAPITAL, WAGGA");
1156	} elsif ($opt->{region} == 75) {
1157	return "Nine" if ($ch eq "CHANNEL NINE BRISBANE METRO");
1158	} elsif ($opt->{region} == 78) {
1159	return "Nine" if ($ch eq "CHANNEL NINE GOLD COAST");
1160	return "NBN" if ($ch eq "NBN GOLD COAST");
1161	return "Prime" if ($ch eq "PRIME GOLD COAST");
1162	return "Sthn Cross TEN" if ($ch eq "Sthn Cross TEN NORTHERN NSW, GOLD COAST");
1163	} elsif ($opt->{region} == 79) {
1164	return "Seven (Cairns)" if ($ch eq "CHANNEL SEVEN QUEENSLAND, CAIRNS");
1165	return "Seven (Townsville/Mackay/Wide Bay/Sunshine Coast)" if ($ch eq "CHANNEL SEVEN QUEENSLAND, TOWNSVILLE/MACKAY");
1166	return "Seven (Rockhampton/Toowoomba)" if ($ch eq "CHANNEL SEVEN QUEENSLAND, ROCKHAMPTON/TOOWOOMBA");
1167	return "TEN" if ($ch eq "Sthn Cross TEN QUEENSLAND");
1168	return "WIN (Mackay/Wide Bay)" if ($ch eq "WIN TELEVISION QLD, MACKAY/WIDE BAY");
1169	return "WIN (QLD: Regional)" if ($ch eq "WIN TELEVISION QLD, REGIONAL QLD");
1170	} elsif ($opt->{region} == 85) {
1171	return "WIN" if ($ch eq "WIN TELEVISION SOUTH EAST SA");
1172	} elsif ($opt->{region} == 86) {
1173	return "Sthn Cross TEN" if ($ch eq "Southern Cross");
1174	} elsif ($opt->{region} == 88) {
1175	return "TDT" if ($ch eq "TASMANIAN DIGITAL TELEVISION");
1176	} elsif ($opt->{region} == 90) {
1177	return "Prime (Albury)" if ($ch eq "PRIME TELEVISION, ALBURY");
1178	return "Prime (Regional)" if ($ch eq "PRIME TELEVISION, REGIONAL VICTORIA");
1179	return "TEN" if ($ch eq "Sthn Cross TEN VICTORIA");
1180	} elsif ($opt->{region} == 95) {
1181	return "Prime" if ($ch eq "PRIME TELEVISION, REGIONAL VICTORIA");
1182	} elsif ($opt->{region} == 98) {
1183	return "Prime" if ($ch eq "PRIME TELEVISION, REGIONAL VICTORIA");
1184	return "TEN" if ($ch eq "Sthn Cross TEN VICTORIA");
1185	} elsif ($opt->{region} == 101) {
1186	return "Access 31" if ($ch eq "ACCESS 31");
1187	} elsif ($opt->{region} == 102) {
1188	return "Golden West" if ($ch eq "GOLDEN WEST NETWORK");
1189	} elsif ($opt->{region} == 106) {
1190	return "Prime" if ($ch eq "PRIME SOUTHERN, WAGGA WAGGA/ORANGE");
1191	} elsif ($opt->{region} == 126) {
1192	return "Prime" if ($ch eq "PRIME SOUTHERN, CANBERRA/WOLLONGONG/STH COAST");
1193	return "TEN" if ($ch eq "Sthn Cross TEN CAPITAL, CANBERRA");
1194	} elsif ($opt->{region} == 184) {
1195	return "Prime" if ($ch eq "PRIME NORTHERN, NEWCASTLE");
1196	return "Sthn Cross TEN" if ($ch eq "Sthn Cross TEN NORTHERN NSW, NON GOLD COAST");
1197	}
1198
1199	return $ch; # no match
1200	}

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/grabbers/ninemsn

Download in other formats: