Context Navigation

ninemsn @ 509

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

Note: See TracBrowser for help on using the browser.

Context Navigation

root/grabbers/ninemsn @ 509

Download in other formats: