Context Navigation

source: trunk/references/Shepherd/Configure.pm @ 1465

Last change on this file since 1465 was 1465, checked in by mbarry, 10 years ago
Shepherd::Configure: Remove --color option from 'ls' command, since it causes a fatal error on BSD.
File size: 39.7 KB

Line
1
2	package Shepherd::Configure;
3
4	my $version = '0.32';
5
6	use strict;
7	no strict 'refs';
8
9	use XMLTV;
10
11	my %REGIONS =
12	(
13	63 => "NSW: Broken Hill", 66 => "NSW: Central Coast", 67 => "NSW: Griffith",
14	69 => "NSW: Tamworth", 71 => "NSW: Wollongong", 73 => "NSW: Sydney",
15	74 => "NT: Darwin", 75 => "QLD: Brisbane", 78 => "QLD: Gold Coast",
16	79 => "QLD: Cairns", 81 => "SA: Adelaide", 82 => "SA: Renmark",
17	83 => "SA: Riverland", 85 => "SA: South East SA", 86 => "SA: Spencer Gulf",
18	88 => "TAS: Tasmania", 90 => "VIC: Ballarat", 93 => "VIC: Geelong",
19	94 => "VIC: Melbourne", 95 => "VIC: Mildura/Sunraysia", 98 => "VIC: Gippsland",
20	101 => "WA: Perth", 102 => "WA: Regional", 106 => "NSW: Remote and Central",
21	107 => "SA: Remote and Central", 108 => "NT: Remote and Central", 114 => "QLD: Remote and Central",
22	126 => "ACT: Canberra", 184 => "NSW: Newcastle", 253 => "QLD: Mackay",
23	254 => "QLD: Rockhampton", 255 => "QLD: Sunshine Coast", 256 => "QLD: Toowoomba",
24	257 => "QLD: Townsville", 258 => "QLD: Wide Bay", 259 => "NSW: Far South Coast",
25	261 => "NSW: Lismore/Coffs Harbour", 262 => "NSW: Orange/Dubbo", 263 => "NSW: Taree/Port Macquarie",
26	264 => "NSW: Wagga Wagga", 266 => "VIC: Bendigo", 267 => "VIC: Shepparton",
27	268 => "VIC: Albury/Wodonga"
28	);
29
30	# -----------------------------------------
31	# Subs: Configuration
32	# -----------------------------------------
33
34	sub configure
35	{
36	if ($::opt->{configure} ne '1')
37	{
38	my $proggy = $::opt->{configure};
39	print "\nAttempting to configure \"$proggy\".\n";
40
41	unless ($::components->{$proggy})
42	{
43	print "Unknown component: \"$proggy\".\n";
44	exit 0;
45	}
46
47	my $progtype = $::components->{$proggy}->{type};
48	unless ($progtype eq 'grabber' or $progtype eq 'postprocessor'
49	or $progtype eq 'reconciler')
50	{
51	print "Cannot configure $progtype components.\n";
52	exit 0;
53	}
54
55	my $option_configure = (&::query_config($proggy, 'option_config') or '--configure');
56	&::call_prog($proggy, &::query_filename($proggy, $progtype) . " $option_configure");
57
58	exit 0;
59	}
60	print "\nConfiguring.\n\n" .
61	"Step 1: Region Selection\n\nSelect your region:\n";
62	foreach (sort { $REGIONS{$a} cmp $REGIONS{$b} } keys %REGIONS)
63	{
64	printf(" (%3d) %s\n", $_, $REGIONS{$_});
65	}
66	$::region = &XMLTV::Ask::ask_choice("Enter region code:", ($::region \|\| "94"),
67	keys %REGIONS);
68
69	print "\nStep 2: Channel Selection\n\n";
70
71	print "Shepherd offers two methods of channel selection: Guided and Advanced.\n".
72	"Guided is easier; Advanced allows manual entering of XMLTV IDs.\n\n";
73
74	my $guided = &XMLTV::Ask::ask_boolean("Would you like Guided channel selection?", 1);
75
76	my $mchans = &configure_channels_guided if ($guided);
77	&configure_channels_advanced unless ($mchans);
78
79	print "\nStep 3: Transitioning\n\n".
80	"Would you like to transition seamlessly from your current grabber?\n\n".
81	"Different data sources can have different names for the same show. For\n".
82	"example, one grabber might call a show \"Spicks & Specks\" while another\n".
83	"calls it \"Spicks and Specks\". These differences can make MythTV think\n".
84	"they're actually different shows.\n\n".
85	ucfirst($::progname) . " is able to merge these differences so that it always\n".
86	"presents shows with a consistent name, no matter where it actually sourced\n".
87	"show data from. If you'd like, it can also rename shows so they're consistent\n".
88	"with whichever grabber you've been using until now.\n\n".
89	"The advantage of this is that you should get a smoother transition to\n".
90	ucfirst($::progname) . ", with no shows changing names and no need to re-create\n".
91	"any recording rules. The main disadvantage is that if your previous grabber\n".
92	"used an inferior data source -- i.e. it sometimes has typos or less\n".
93	"informative program names -- then you'll continue to see these.\n\n".
94	"If you were using one of the following grabbers previously AND you want\n".
95	ucfirst($::progname) . " to use that grabber's program names, select it here.\n\n";
96
97	my $def = "Do not transition; just use best quality titles";
98	my %transition = ( "ltd (aka tv_grab_au, versions 1,30, 1.40 or 1.41)" => 'yahoo7widget',
99	"OzTivo" => 'oztivo',
100	"Rex" => 'rex');
101	my $defaulttrans = $def;
102	foreach my $key (keys %transition) {
103	$defaulttrans = $key if ((defined $::pref_title_source) && ($transition{$key} eq $::pref_title_source));
104	}
105	my $pref = &XMLTV::Ask::ask_choice("Transition from grabber?", $defaulttrans,
106	$def, keys %transition);
107	$::pref_title_source = $transition{$pref};
108
109	print "\n";
110	&::show_channels if (!$mchans);
111	&::show_mythtv_mappings($::debug, $mchans) if ($mchans);
112
113	my $str = "Create configuration file";
114	$str .= " and update MythTV" if ($mchans);
115	unless(&XMLTV::Ask::ask_boolean("\n$str?", 1))
116	{
117	print "Aborting configuration.\n";
118	exit 0;
119	}
120
121	&::write_config_file;
122	&::write_channels_file;
123	&update_mythtv_channels($mchans) if ($mchans);
124
125	print "\nMythTV Integration\n\n".
126	"If you run MythTV, Shepherd can register itself as the default grabber\n".
127	"and set your system to run it regularly to ensure up-to-date guide data.\n".
128	"This is generally easier than doing it yourself.\n\n";
129
130	if (&XMLTV::Ask::ask_boolean("Would you like Shepherd to auto-configure MythTV?", 1))
131	{
132	&configure_mythtv;
133	}
134
135	print "Checking if any components require configuration.\n\n";
136	&::check;
137
138	print "Finished configuring.\n\n";
139
140	&::status;
141
142	print "\nShepherd is installed into $::CWD.\n\n";
143
144	if (&XMLTV::Ask::ask_boolean("\nShepherd can (optionally) install channel icons.\nDo you wish to do this now?")) {
145	&set_icons;
146	}
147
148	print "\nIf you wish to add/change channel icons in future, you can call Shepherd with:\n".
149	" $::CWD/$::progname --set-icons\n\n";
150
151	print "Done.\n";
152	exit 0;
153	}
154
155	sub configure_channels_guided
156	{
157	my $mythids = &::retrieve_mythtv_channels;
158	unless ($mythids)
159	{
160	print "\nUnable to retrieve list of MythTV channels.\n" .
161	"Guided channel selection is not available, now using Advanced.\n";
162	return undef;
163	}
164
165	print "\n* Guided Channel Selection *\n";
166
167	# I believe this is now obsolete. Commenting out; will remove completely
168	# if that proves the case. 08-MAR-12.
169	# print "\nHigh Definition TV (HDTV)\n".
170	# "Most Australian TV networks broadcast at least some\n".
171	# "programmes in HDTV each week, but for the most part\n".
172	# "either upsample SD to HD or play a rolling demonstration\n".
173	# "HD clip when they don't have the programme in HD format.\n\n".
174	# "If you have a HDTV capable system and are interested in\n".
175	# "having Shepherd's postprocessors populate HDTV content\n".
176	# "then Shepherd will need to know the XMLTV IDs for the HD\n".
177	# "channels also. HD related SD channels are required.\n",
178	# "The 7HD, Nine HD and One HD channels are populated\n",
179	# "with programs from the first related SD channel.\n",
180	# "$::wiki/FAQ#MyhighdefinitionHDchannelsaremissingprograms\n\n";
181	#my $want_hdtv = &XMLTV::Ask::ask_boolean("Do you have High-Definition (HDTV)?");
182	my $want_hdtv = 0;
183
184	my (@channellist, @hd_channellist, @paytv_channellist);
185
186	@channellist = sort &::read_official_channels($::region);
187	$::channels = { };
188	$::opt_channels = { };
189	foreach (@channellist)
190	{
191	$::channels->{$_} = undef;
192	}
193
194	if ($want_hdtv)
195	{
196	@hd_channellist = grep(!/ABC2\|ABC1\|SBS News\|31/i, @channellist);
197
198	#limit to ones in $channels (don't know so can't) and if 7HD remove 7HD and first 7 (don't know so do anyway)
199	foreach my $hdchannel (keys %$::hd_to_sds) {
200	@hd_channellist = grep(!/^$hdchannel$/i, @hd_channellist);
201	my $oldlength = scalar @hd_channellist;
202	foreach my $sdchannel (@{$::hd_to_sds->{$hdchannel}}) {
203	@hd_channellist = grep(!/^$sdchannel$/i, @hd_channellist);
204	if ($oldlength != scalar @hd_channellist) { # removed first
205	print "'$hdchannel' is going to be populated from '$sdchannel'\n";
206	last;
207	}
208	}
209	}
210
211	foreach (@hd_channellist)
212	{
213	$_.='HD';
214	$::opt_channels->{$_} = undef;
215	}
216	}
217
218	my $want_paytv = &XMLTV::Ask::ask_boolean("\nDo you have PayTV?");
219	if ($want_paytv)
220	{
221	$want_paytv = &XMLTV::Ask::ask_choice("Which PayTV provider do you have?",
222	$::want_paytv_channels \|\| "Foxtel",
223	("Foxtel", "SelecTV"));
224	$::want_paytv_channels = $want_paytv;
225	@paytv_channellist = &::read_official_channels($want_paytv);
226	foreach (@paytv_channellist)
227	{
228	$::opt_channels->{$_} = undef;
229	}
230	}
231	else
232	{
233	$::want_paytv_channels = undef;
234	}
235
236	my @sdchannels = (@channellist, @hd_channellist);
237	my @allchannels = (@sdchannels, @paytv_channellist);
238	my @paytvchannels = ((undef) x scalar(@sdchannels), (@paytv_channellist));
239
240	printf "\nYour MythTV has %d channels. Shepherd offers %d channels of guide\n".
241	"data for %s (%d free-to-air, %d Pay TV, %d simulcast/HDTV).\n\n".
242	"Please associate each MythTV channel with a Shepherd guide data\n".
243	"channel.\n\n",
244	scalar(@$mythids),
245	scalar(@allchannels),
246	$REGIONS{$::region},
247	scalar(@channellist),
248	scalar(@paytv_channellist),
249	scalar(@hd_channellist);
250
251	my $display_mode = 0;
252	foreach my $mch (@$mythids)
253	{
254	my @table = $display_mode ? @paytvchannels : @sdchannels;
255	if ($want_paytv)
256	{
257	push @table, ($display_mode ? 'f:(Free to Air channel)' : 'p:(Pay TV channel)' );
258	}
259
260	&guided_configure_table(@table);
261
262	my $longname = $mch->{name};
263	$longname .= " ($mch->{callsign})" if ($mch->{callsign} and lc($mch->{callsign}) ne lc($longname));
264
265	my $default_str = "";
266	my $default_index = 0;
267	my $guide_index = 0;
268
269	# Determine if the current xmltvid for the channel in the database
270	# corresponds to a shephed channel, and if it does, offer that as
271	# the default.
272
273	foreach (@table)
274	{
275	my $guide_xmltvid = $allchannels[$guide_index];
276	if ($_ and $guide_xmltvid)
277	{
278	$guide_xmltvid = lc "$guide_xmltvid.shepherd.au";
279	$guide_xmltvid =~ s/ //g;
280
281	if ($guide_xmltvid eq $mch->{xmltvid})
282	{
283	$default_index = $guide_index;
284	}
285	}
286
287	$guide_index++;
288	}
289
290	if ($default_index == 0)
291	{
292	my $munged_callsign = &munge($mch->{callsign});
293	my $munged_name = &munge($mch->{name});
294
295	++$default_index until
296	munge($table[$default_index]) eq $munged_callsign or
297	munge($table[$default_index]) eq $munged_name or
298	$default_index > $#table;
299	}
300
301	if ($default_index > $#table)
302	{
303	$default_str = "0 (no guide)";
304	$default_index = 0;
305	}
306	else
307	{
308	$default_str = "$table[$default_index]";
309	$default_index++;
310	$default_str = "$default_index ($default_str)"
311	}
312
313	my $channum = $mch->{channum} \|\| '-';
314	printf "MythTV channel %s: %s [default=%s] ? ",
315	$channum,
316	$longname,
317	$default_str;
318	my $inp = <STDIN>;
319	chomp $inp;
320	if ($inp eq '?')
321	{
322	# TODO: &guided_configure_help;
323	redo;
324	}
325	elsif ($inp eq 'f')
326	{
327	$display_mode = 0;
328	redo;
329	}
330	elsif ($inp eq 'p')
331	{
332	$display_mode = 1;
333	redo;
334	}
335
336	if ($inp eq "")
337	{
338	$inp = "$default_index";
339	}
340
341	if ($inp =~ /\d+/)
342	{
343	my $xmltvid = '';
344	if ($inp == 0)
345	{
346	print "$mch->{name} -> (no guide data)\n";
347	}
348	else
349	{
350	$inp--;
351	my $target = $allchannels[$inp];
352	unless ($target)
353	{
354	print "Unknown #: $inp\n";
355	redo;
356	}
357	$xmltvid = lc "$target.shepherd.au";
358	$xmltvid =~ s/ //g;
359	if ($inp < @channellist)
360	{
361	$::channels->{$target} = $xmltvid;
362	}
363	else
364	{
365	$::opt_channels->{$target} = $xmltvid;
366	}
367	print "$mch->{name} -> $allchannels[$inp].\n";
368	}
369	$mch->{xmltvid} = $xmltvid;
370	}
371	else
372	{
373	print "Unknown selection. Please try again.\n";
374	redo;
375	}
376	}
377
378	# Removed by Max (17-Apr-2012) as part of a slow deletion of
379	# $opt_channels (no longer necessary for HDTV).
380	#
381	# foreach (keys %$::opt_channels)
382	# {
383	# if (defined $::opt_channels->{$_} && $_ =~ /HD$/) {
384	# my $sd = $_;
385	# $sd =~ s/HD$//;
386	# if (!defined $::channels->{$sd}) {
387	# print "No corresponding SD channel for a HD channel. '$_' needs '$sd'. Please try again.\n";
388	# exit;
389	# }
390	# }
391	# }
392
393	foreach (keys %$::channels)
394	{
395	delete $::channels->{$_} unless defined $::channels->{$_};
396	}
397	foreach (keys %$::opt_channels)
398	{
399	delete $::opt_channels->{$_} unless defined $::opt_channels->{$_};
400	}
401
402	&::show_mythtv_mappings($::debug, $mythids);
403
404	print "\nIf you proceed to the end of configuration, Shepherd will\n" .
405	"write these channel mappings to MythTV.\n\n";
406
407	exit unless (&XMLTV::Ask::ask_boolean("Is this table correct? ", 1));
408
409	return $mythids;
410	}
411
412	sub guided_configure_table
413	{
414	my @chs;
415	my $skip = 0;
416	foreach (@_)
417	{
418	if (defined $_)
419	{
420	push @chs, $_;
421	}
422	else
423	{
424	$skip++;
425	}
426	}
427
428	@chs = ('(no guide)', @chs);
429
430	my $half = int(scalar(@chs) / 2);
431	$half++ if (scalar(@chs) % 2);
432
433	my $i = 0;
434	my $n;
435	my $str = '';
436	while ($i < $half)
437	{
438	$n = $i;
439	$n += $skip if ($n);
440	my $selection = &guided_configure_table_entry($chs[$i], $n);
441	$n += $skip if (!$n);
442	$selection .= &guided_configure_table_entry($chs[$i+$half], $n+$half) if ($i + $half < @chs);
443	$str .= "$selection\n";
444	$i++;
445	}
446	print "Guide data sources:\n$str";
447	}
448
449	sub guided_configure_table_entry
450	{
451	my ($entry, $num) = @_;
452	if ($entry =~ /^(\w):(.*)/)
453	{
454	$num = $1;
455	$entry = $2;
456	}
457	return sprintf "(%2s) %-30s", $num, $entry;
458	}
459
460	sub configure_channels_advanced
461	{
462	my @channellist = &::read_official_channels($::region);
463
464	$::channels = channel_selection("Free to Air", ".free.au", $::channels, @channellist);
465	&::check_channel_xmltvids;
466
467	my $old_opt_channels = $::opt_channels;
468	# print "\nHigh Definition TV (HDTV)\n".
469	# "Most Australian TV networks broadcast at least some\n".
470	# "programmes in HDTV each week, but for the most part\n".
471	# "either upsample SD to HD or play a rolling demonstration\n".
472	# "HD clip when they don't have the programme in HD format.\n\n".
473	# "If you have a HDTV capable system and are interested in\n".
474	# "having Shepherd's postprocessors populate HDTV content\n".
475	# "then Shepherd will need to know the XMLTV IDs for the HD\n".
476	# "channels also. HD related SD channels are required.\n",
477	# "The 7HD, Nine HD and One HD channels are populated\n",
478	# "with programs from the first related SD channel.\n",
479	# "$::wiki/FAQ#MyhighdefinitionHDchannelsaremissingprograms\n";
480	# if (&XMLTV::Ask::ask_boolean("\nDo you wish to include HDTV channels?"))
481	if (0)
482	{
483	#limit to ones in $channels and if 7HD remove 7HD and first 7
484	my @hd_channellist = grep(!/ABC2\|TEN\|SBS TWO\|31/i, keys %$::channels);
485
486	foreach my $hdchannel (keys %$::hd_to_sds) {
487	my $oldlength = scalar @hd_channellist;
488	@hd_channellist = grep(!/^$hdchannel$/i, @hd_channellist);
489	next if ($oldlength == scalar @hd_channellist); # didn't remove
490	$oldlength = scalar @hd_channellist;
491	foreach my $sdchannel (@{$::hd_to_sds->{$hdchannel}}) {
492	@hd_channellist = grep(!/^$sdchannel$/i, @hd_channellist);
493	if ($oldlength != scalar @hd_channellist) { # removed first
494	print "'$hdchannel' is going to be populated from '$sdchannel'\n";
495	last;
496	}
497	}
498	}
499
500	foreach (@hd_channellist)
501	{
502	$_ .= "HD";
503	}
504
505	$::opt_channels = channel_selection("HDTV", ".hd.free.au", $old_opt_channels, @hd_channellist);
506	&::check_channel_xmltvids;
507	}
508	else
509	{
510	$::opt_channels = { };
511	}
512
513	if (&XMLTV::Ask::ask_boolean("\nDo you wish to include PayTV (e.g. Foxtel, SelecTV) channels?", defined $::want_paytv_channels))
514	{
515	$::want_paytv_channels = &XMLTV::Ask::ask_choice("Which PayTV provider?", $::want_paytv_channels \|\| "Foxtel", ("Foxtel", "SelecTV"));
516	my @paytv_channellist = &::read_official_channels($::want_paytv_channels);
517	my $paytv = channel_selection("Pay TV", ".paytv.au", $old_opt_channels, @paytv_channellist);
518	if (keys %$paytv) {
519	$::opt_channels = { %$::opt_channels, %$paytv };
520	} else {
521	$::want_paytv_channels = undef;
522	}
523	&::check_channel_xmltvids;
524	}
525	else
526	{
527	$::want_paytv_channels = undef;
528	}
529	}
530
531	# Sourced from YourTV
532	sub fetch_regions
533	{
534	my ($reg, $shh) = @_;
535
536	&::log("Fetching free-to-air region information...\n") unless ($shh);
537
538	# Download list
539	my $ua = LWP::UserAgent->new();
540	$ua->env_proxy;
541	$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
542	$ua->cookie_jar({});
543	$ua->get('http://www.yourtv.com.au');
544	my $response = $ua->get('http://www.yourtv.com.au/?');
545
546	my $page = $response->content;
547	die "Unable to download region list page" if ($response->is_error());
548
549	die "Unable to parse region list" if (!($page =~ /<select[^>]fta_region_id[^>]>(.*?)<\/select>/is));
550	my $regions = $1;
551
552	my %regions;
553	while ($regions =~ /value.?(\d+).?>(.*?)(<\|$)/sg) {
554	my ($num, $name) = ($1, $2);
555	$name =~ s/^\s+//s;
556	$name =~ s/\s+$//s;
557	$name =~ s/\s+/ /gs;
558	$name =~ s/ -/:/;
559
560	$regions{$num} = $name;
561	#printf "Downloaded %d %s\n", $num, $name;
562	}
563
564	my %REGIONSLOCAL = %REGIONS;
565	my %regionslocal = %regions;
566	foreach my $num (keys %regionslocal) {
567	#printf "Checking %d %s\n", $num, $regions{$num};
568	if (!defined($REGIONSLOCAL{$num}) \|\| $REGIONS{$num} ne $regions{$num}) {
569	#printf "Missing %d %s\n", $num, $regions{$num};
570	} else {
571	delete $REGIONSLOCAL{$num};
572	delete $regionslocal{$num};
573	}
574	}
575
576	if ((scalar(keys %REGIONSLOCAL) != 0) \|\| (scalar(keys %regionslocal) != 0)) {
577	print "old regions not matched:\n";
578	foreach (sort { $REGIONSLOCAL{$a} cmp $REGIONSLOCAL{$b} } keys %REGIONSLOCAL) {
579	printf(" %3d %s\n", $_, $REGIONSLOCAL{$_});
580	}
581	print "new regions not matched:\n";
582	foreach (sort { $regionslocal{$a} cmp $regionslocal{$b} } keys %regionslocal) {
583	printf(" %3d %s\n", $_, $regionslocal{$_});
584	}
585	print "new region list:\n";
586	my $count = 0;
587	print "\tmy %REGIONS = (";
588	foreach (sort { $a <=> $b } keys %regions) {
589	if ($count%3 == 0) {
590	print"\n\t\t";
591	} else {
592	print"\t";
593	}
594	printf('%d => "%s",', $_, $regions{$_});
595	$count+=1;
596	}
597	print ");\n";
598	}
599	}
600
601	# Sourced from YourTV
602	sub fetch_channels
603	{
604	my ($reg, $shh) = @_;
605
606	&::log("Fetching free-to-air channel information...\n") unless ($shh);
607
608	# Download list
609	my $ua = LWP::UserAgent->new();
610	$ua->env_proxy;
611	$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
612	$ua->cookie_jar({});
613	$ua->get('http://www.yourtv.com.au');
614	my $response = $ua->get('http://www.yourtv.com.au/profile/ajax.cfm?action=channels&region_id='.$reg);
615
616	my $page = $response->content;
617	die "Unable to download channel list" if ($response->is_error());
618
619	# Rules for Station Names:
620	# Station names are comprised of the channel name (eg "Seven") and an
621	# optional regional qualifier in brackets (eg "(Cairns/Rockhampton)").
622	# Station names shall not contain a regional qualifer unless
623	# necessary to distinguish between identical channel names in
624	# the same region; in this case, a regional qualifier shall always
625	# be included. In the absence of anything better, the region name
626	# (eg "NSW: Regional NSW") is used as the regional qualifier.
627	my (@channellist, $clist, $cn, $rq);
628	while ($page =~ /<label for="venue_id.?>(.?)<\/label>/sg)
629	{
630	my $channel = $1;
631	$channel =~ s/\s{2,}//g;
632	if ($channel =~ /(.) (\(.\))/)
633	{
634	($cn, $rq) = ($1, $2);
635	}
636	else
637	{
638	$cn = $channel;
639	$rq = '';
640	}
641	# Is there already a channel with this name?
642	if ($clist->{$cn})
643	{
644	# Set regional qualifier for existing station if not already set
645	if (@{$clist->{$cn}} == 1 and $clist->{$cn}[0] eq '')
646	{
647	$clist->{$cn} = [ "(".$REGIONS{$reg}.")" ];
648	}
649	$rq = $REGIONS{$reg} if ($rq eq '');
650	die "Bad channel list in region $reg!" if (grep($rq eq $_, @{$clist->{$cn}}));
651	push @{$clist->{$cn}}, $rq;
652	}
653	else
654	{
655	$clist->{$cn} = [ $rq ];
656	}
657	}
658	foreach $cn (keys %$clist)
659	{
660	if (@{$clist->{$cn}} == 1)
661	{
662	push @channellist, $cn;
663	}
664	else
665	{
666	foreach $rq (@{$clist->{$cn}})
667	{
668	push @channellist, "$cn $rq";
669	}
670	}
671	}
672	return @channellist;
673	}
674
675	sub fetch_channels_foxtel # web parsing broken (http://www.foxtel.com.au/discover/channels/default.htm wrong format)
676	{
677	my $shh = shift;
678	&::log("Fetching PayTV channel information...\n") unless ($shh);
679
680	my $ua = LWP::UserAgent->new();
681	$ua->env_proxy;
682	$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
683	$ua->cookie_jar({});
684	my $response = $ua->get('http://www.foxtel.com.au/channel/lineup.html');
685
686	my $page = $response->content;
687	die "Unable to download channel list" if ($response->is_error());
688
689	my @channellist;
690	while ($page =~ /<option value="\/channel\/.?>(.?)<\/option>/sg)
691	{
692	my $ch = $1;
693	$ch =~ s/[ \t()\[\]\+\.\-]//g; # remove special chars
694	$ch =~ s/(&\|&)/and/g; # & to and
695	$ch =~ s\|[/,].*\|\|; # and deleting after / or ,
696
697	push @channellist,$ch;
698	}
699
700	return @channellist;
701	}
702
703	sub fetch_channels_selectv # web parsing broken
704	{
705	my $shh = shift;
706	&::log("Fetching PayTV channel information...\n") unless ($shh);
707
708	my $ua = LWP::UserAgent->new();
709	$ua->env_proxy;
710	$ua->agent('Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322');
711	$ua->cookie_jar({});
712	my $response = $ua->get('http://www.selectv.com/go/tv-guide');
713
714	my $page = $response->content;
715	die "Unable to download channel list" if ($response->is_error());
716
717	my @channellist;
718	while ($page =~ /<option value=".?">(.?)<\/option>/sg)
719	{
720	my $ch = $1;
721	$ch =~ s/[ \t()\[\]\+\.\-]//g; # remove special chars
722	$ch =~ s/(&\|&)/and/g; # & to and
723	$ch =~ s\|[/,].*\|\|; # and deleting after / or ,
724
725	# also in selectv_website
726	my %SelecTV_to_Foxtel = (
727	"AnimalPlanet" => "AnimalPlanet",
728	"AntennaGreek" => "AntennaGreek", # SelecTV only
729	"BBCWorld" => "BBCWorldNews",
730	"CartoonNetwork" => "CartoonNetwork",
731	"CNNI" => "CNN", # rename
732	"DiscoveryScience" => "DiscoveryScience",
733	"DiscoveryHomeandHealth" => "DiscoveryHealth", # rename
734	"DiscoveryTravelandLiving" => "DiscoveryTravel",# rename
735	"DiscoveryRealTime" => "DiscoveryRealTime", # SelecTV and OzTivo
736	"E!Entertainment" => "E!Entertainment",
737	"ERTGreek" => "ERTGreek", # SelecTV only
738	"Eurosport" => "Eurosport", # SelecTV and OzTivo
739	"FashionTV" => "FashionTV",
740	"MovieExtra" => "MOVIEEXTRA", # rename
741	"MovieGreats" => "MOVIEGREATS", # rename
742	"MovieOne" => "MOVIEONE", # rename
743	"MovieTwo" => "MOVIETWO", # rename
744	"MTV" => "MTV",
745	"NatGeoAdventure" => "NatGeoAdventure",
746	"NationalGeographic" => "NationalGeographic",
747	"Ovation" => "Ovation",
748	"SkyRacing" => "SkyRacing",
749	"TurnerClassicMovies" => "TCM", # rename
750	"TVChileSpanish" => "TVChileSpanish", # SelecTV and OzTivo
751	"TVE" => "TVE", # SelecTV and OzTivo
752	"VH1" => "VH1",
753	);
754	print " Unknown channel: $ch\n" if !exists($SelecTV_to_Foxtel{$ch});
755	$ch = $SelecTV_to_Foxtel{$ch} if $SelecTV_to_Foxtel{$ch};
756
757	push @channellist,$ch;
758	}
759
760	return @channellist;
761	}
762
763	# Channel Selection (advanced/manual entering of XMLTV IDs)
764	#
765	# We try to help users match XMLTV IDs to their MythTV installation.
766	# We also try to make all the defaults match what they selected last
767	# time, if they're re-running configure.
768	sub channel_selection
769	{
770	my ($type, $default_tail, $old_channels, @channellist) = @_;
771
772	my $mythids = &::retrieve_mythtv_channels;
773
774	my %mhash;
775	foreach my $ch (@$mythids)
776	{
777	$mhash{$ch->{'xmltvid'}} = $ch;
778	}
779
780	print "\nYour region has " . scalar(@channellist) . " $type channels:\n " .
781	join(', ', @channellist) . ".\n\n";
782
783	my $newchannels = {};
784	my $line;
785	my $c = 1;
786	print "\nEach channel you want guide data for needs a unique XMLTV ID. You can type\n".
787	"in an ID of your choice, or press ENTER to accept the suggested [default],\n".
788	"or type in \"n\" to skip this channel.\n\n".
789	"Please don't subscribe to unneeded channels.\n\n".
790	"$type Channels:\n";
791	foreach my $ch (@channellist)
792	{
793	my $default;
794	my $status = "new";
795
796	# Ideally, keep what they assigned last time.
797	if ($old_channels->{$ch})
798	{
799	$status = "previously configured";
800	$default = $old_channels->{$ch};
801	}
802	# If it looks like a channel in MythTV, suggest that.
803	elsif ($mhash{$ch})
804	{
805	$default = $mhash{$ch}->{xmltvid};
806	}
807	# Otherwise make up a name
808	else
809	{
810	$default = lc($ch); # make a default id by lower-casing
811	$default =~ s/[ \t()]//g; # removing whitespace and parens
812	$default =~ s\|[/,].*\|\|; # and deleting after / or ,
813	$default .= $default_tail; # and tack on something like ".free.au".
814	}
815
816	printf "(%2d/%2d) \"%s\" (%s)\n", $c, scalar(@channellist), $ch, $status;
817
818	# Notify user if we found a matching MythTV channel
819	if ($mhash{$ch})
820	{
821	my $channum = $mhash{$ch}->{channum} \|\| '-';
822	printf " Looks like MythTV channel #%s: \"%s\" (%s)\n",
823	$channum,
824	$mhash{$ch}->{name},
825	$mhash{$ch}->{callsign};
826	if ($default ne $mhash{$ch}->{xmltvid})
827	{
828	printf " Current ID is \"%s\" but MythTV Ch #%s is \"%s\"\n",
829	$default, $channum, $mhash{$ch}->{xmltvid};
830	}
831	}
832
833	# Don't subscribe by default when user has configured previously
834	# and ignored this channel, or if it's a FTA Channel 31 variant.
835	if ($status eq 'new' and keys %$old_channels)
836	{
837	print " If subscribing, suggest \"$default\".\n";
838	$default = "";
839	}
840
841	$line = &XMLTV::Ask::ask(" [$default] ? ");
842	$line =~ s/\s//g;
843
844	# Some users think they can enter 'y' to accept default
845	if (lc($line) eq 'y' or lc($line) eq 'yes')
846	{
847	if ($default)
848	{
849	$newchannels->{$ch} = $default;
850	}
851	else
852	{
853	print "No default value: please enter an XMLTV ID of your choice.\n";
854	redo;
855	}
856	}
857	elsif ($line ne 'n' and ($line =~ /\w/ or $default))
858	{
859	$newchannels->{$ch} = $line \|\| $default;
860	}
861
862	# Check XMLTV ID is unique
863	foreach (keys %$newchannels)
864	{
865	next if ($_ eq $ch);
866	if ($newchannels->{$_} and $newchannels->{$ch} and $newchannels->{$_} eq $newchannels->{$ch})
867	{
868	print "ERROR: You have entered identical XMLTV IDs for $ch and $_ (\"$newchannels->{$_}\"). Exiting.\n";
869	exit;
870	}
871	}
872	$c++;
873	}
874	printf "\nYou are subscribing to %d %s channels:\n",
875	scalar(keys %$newchannels), $type;
876	print "* $_ -> $newchannels->{$_}\n" for sort keys %$newchannels;
877
878	my @not = grep (!$newchannels->{$_}, @channellist);
879	printf "\nYou are not subscribing to %d other channel%s: %s.\n",
880	scalar(@not), (@not > 1 ? 's' :''), join(', ', @not)
881	if (@not);
882	return $newchannels;
883	}
884
885	sub update_mythtv_channels
886	{
887	my $mchans = shift;
888	eval
889	{
890	use lib 'references';
891	require Shepherd::MythTV;
892
893	my $dbh = &Shepherd::MythTV::open_connection;
894	exit unless ($dbh);
895	my $sth = $dbh->prepare("UPDATE channel SET xmltvid = ? WHERE name = ? AND channum = ? ");
896	foreach my $mch (@$mchans)
897	{
898	$sth->execute($mch->{xmltvid}, $mch->{name}, $mch->{channum});
899	}
900	&Shepherd::MythTV::close_connection;
901	&::log("Successfully updated MythTV channels.\n");
902	};
903	if ($@)
904	{
905	&::log("Error trying to access MythTV database: $@\n");
906	return undef;
907	}
908	}
909
910	# ------------------------------
911	# - List Channel Names -
912	# ------------------------------
913	#
914	# This does a web lookup rather than reading the official
915	# channels_list reference.
916	sub list_chan_names
917	{
918	printf "Select your region:\n";
919	printf(" (%3d) %s\n", 0, 'All regions (including PayTV and does regions check)');
920
921	foreach (sort { $REGIONS{$a} cmp $REGIONS{$b} } keys %REGIONS) {
922	printf(" (%3d) %s\n", $_, $REGIONS{$_});
923	}
924	my $reg = &XMLTV::Ask::ask_choice("Enter region code:", ($::region \|\| "94"),
925	'0', keys %REGIONS);
926
927	if (!$reg)
928	{
929	&fetch_regions;
930
931	print "\nListing channels for all regions:\n";
932
933	my @rchans = &fetch_channels_foxtel;
934	printf "\nFoxtel:%s\n", join (',', @rchans);
935	list_chan_names_diff("Foxtel", @rchans);
936	print "\n Use to update channel_list and foxtel_swf.conf (remove ACC from foxtel_swf.conf and check mapping to foxtel in oztivo)\n";
937	print " Remove from above Channel7Adelaide,Channel7Brisbane,Channel7Melbourne,Channel7Perth,Channel7Sydney\n\n";
938
939	@rchans = &fetch_channels_selectv;
940	printf "\nSelecTV:%s\n", join (',', @rchans);
941	list_chan_names_diff("SelecTV", @rchans);
942	print "\n Use to update channel_list and selectv_website.conf (check mapping to foxtel in shepherd and selectv_website, and check oztivo mapping)\n\n";
943
944	my $channel_support_exceptions = '';
945	foreach my $id (sort { scalar($a) <=> scalar($b) } keys %REGIONS)
946	{
947	my @rchans = fetch_channels($id, 1);
948	printf "%s:%s\n", $id, join(',', @rchans);
949	my $cse = list_chan_names_diff($id, @rchans);
950	$channel_support_exceptions = "$channel_support_exceptions $cse"
951	if $cse;
952	sleep 1;
953	}
954
955	print "\n\'channel_support_exceptions\' => \'$channel_support_exceptions\',\n";
956
957	return;
958	}
959
960	printf "\nChannels for region %d (%s) are as follows:\n\t%s\n\n",
961	$reg, $REGIONS{$reg}, join("\n\t",fetch_channels($reg));
962	}
963
964	sub list_chan_names_diff
965	{
966	my $id = shift;
967	my @rchans = @_;
968
969	my @ochans = &::read_official_channels($id);
970	my $line = '';
971	my $channel_support_exceptions = '';
972
973	my $count = scalar(@rchans);
974	foreach my $chan (@ochans) {
975	@rchans = grep($chan ne $_, @rchans);
976	if ($count == scalar(@rchans)) { # didn't find
977	$line = "$line-$chan,";
978	$chan =~ s/ /_/g;
979	if ($channel_support_exceptions) {
980	$channel_support_exceptions = "$channel_support_exceptions,$chan";
981	} else {
982	$channel_support_exceptions = "$chan";
983	}
984	} else {
985	$count = scalar(@rchans);
986	}
987	}
988	foreach my $chan (@rchans) { # didn't remove
989	$line = "$line+$chan,";
990	}
991	if ($line) {
992	print " difference: $line\n";
993	}
994
995	$channel_support_exceptions = "$id:-$channel_support_exceptions"
996	if $channel_support_exceptions;
997
998	return $channel_support_exceptions;
999	}
1000
1001	# ------------------------------
1002	# - MythTV Integration -
1003	# ------------------------------
1004	#
1005	#
1006
1007	sub configure_mythtv
1008	{
1009	&::log("\nConfiguring MythTV...\n\n" .
1010	"This will:\n".
1011	"1. Create a symbolic link to Shepherd from tv_grab_au\n".
1012	"2. Register Shepherd with MythTV as the default grabber\n".
1013	"3. Turn off MythTV-driven scheduling of guide data updates\n".
1014	"4. Turn off EIT\n".
1015	"5. Create a cron job to periodically run Shepherd.\n\n");
1016
1017	# 1. Check existence of symlink
1018
1019	my $me = "$::CWD/applications/shepherd/shepherd";
1020
1021	&::log("Step 1: Setting up symlink...\n".
1022	"------\n");
1023
1024	my $mapped = 0;
1025	my $symlink;
1026	my @delete_me;
1027	foreach my $path (split/:/, $ENV{PATH})
1028	{
1029	my $tv_grab_au = "$path/tv_grab_au";
1030
1031	# Figure out an appropriate symlink.
1032	# (We'll use /usr/bin/tv_grab_au, but only if
1033	# /usr/bin/ is in PATH.)
1034	$symlink = $tv_grab_au unless ($symlink && $symlink eq '/usr/bin/tv_grab_au');
1035
1036	if (-e $tv_grab_au)
1037	{
1038	if (-l $tv_grab_au)
1039	{
1040	my $link = readlink($tv_grab_au);
1041	if ($link and $link eq $me)
1042	{
1043	&::log("Symlink $tv_grab_au is correctly mapped to $me.\n");
1044	$mapped = $tv_grab_au;
1045	last;
1046	}
1047	}
1048	push @delete_me, $tv_grab_au;
1049	}
1050	}
1051
1052	&::log("\n");
1053
1054	if (!$mapped or @delete_me)
1055	{
1056	if (@delete_me)
1057	{
1058	&::log("\nShepherd would like to DELETE the following file(s):\n\n");
1059	system ("ls -l @delete_me");
1060	&::log("\n");
1061	}
1062	if (!$mapped)
1063	{
1064	&::log("Shepherd would like to CREATE the following symlink:\n\n".
1065	" $symlink -> $me\n\n");
1066	}
1067
1068	my $response = &XMLTV::Ask::ask_boolean(
1069	ucfirst(
1070	($mapped ? '' : ( 'create symlink ' . (@delete_me ? 'and ' : ''))) .
1071	(@delete_me ? 'delete ' . scalar(@delete_me) . ' file(s)' : '')) .
1072	'?', 1);
1073	unless ($response)
1074	{
1075	&::log("Aborting.\n");
1076	return;
1077	}
1078
1079	system("sudo rm @delete_me") if (@delete_me);
1080	system("sudo ln -s $me $symlink") unless ($mapped);
1081	}
1082
1083	&::log("Symlink established:\n");
1084	system("ls -l `which tv_grab_au`");
1085
1086	# 2. Insert 'tv_grab_au' into mythconverg -> videosource
1087
1088	&::log("\nStep 2: Registering Shepherd as tv_grab_au with MythTV.\n".
1089	"------\n");
1090
1091	# No eval because I want to bomb out if this fails:
1092	# no point creating cron jobs if they won't work.
1093	eval
1094	{
1095	use lib 'references';
1096	require Shepherd::MythTV;
1097	};
1098	if ($@)
1099	{
1100	print "\n!!! ERROR !!!\n" .
1101	"Unable to load reference Shepherd::MythTV.\n" .
1102	"<<<<<< output from Shepherd/MythTV.pm was as follows:\n" .
1103	"$@\n" .
1104	">>>>>> end output from Shepherd/MythTV.pm\n" .
1105	"Cannot configure MythTV.\n";
1106	if ($@ =~ /Sort\/Versions/)
1107	{
1108	print "You probably need the \"Sort::Versions\" Perl module.\n" .
1109	"On Ubuntu, Sort::Versions is available via the command:\n" .
1110	" sudo apt-get install libsort-versions-perl\n";
1111	}
1112	return;
1113	}
1114
1115	my $dbh = &Shepherd::MythTV::open_connection();
1116	return unless ($dbh);
1117	$dbh->do("UPDATE videosource SET xmltvgrabber='tv_grab_au'")
1118	\|\| die "Error updating MythTV database: ".$dbh->errstr;
1119
1120	# 3. Disable MythTV auto guide updates
1121
1122	&::log("Registered.\n\n".
1123	"Step 3: Turning off MythTV-scheduled guide data updates...\n".
1124	"------\n");
1125	$dbh->do("UPDATE settings SET data='0' WHERE value='MythFillEnabled'")
1126	\|\| &::log("Warning: Unable to check/update MythFillEnabled setting: ".$dbh->errstr.".\n");
1127
1128	&::log("MythTV database updated.\n\n");
1129
1130	# 4. Disable EIT
1131
1132	&::log("Step 4: Disabling EIT...\n".
1133	"------\n" .
1134	"(Info: EIT is an over-the-air broadcast guide. It tends to be unreliable\n".
1135	"in Australia and should be disabled to prevent it overriding Shepherd.)\n\n");
1136
1137	my $needs_update = 0;
1138
1139	my $data = $dbh->selectall_arrayref("SELECT cardid,dvb_eitscan FROM capturecard") \|\|
1140	&::log("Database error: " . $dbh->errstr);
1141	if ($data)
1142	{
1143	&::log(" Card ID EIT Scanning\n".
1144	"--------------------------\n");
1145	foreach (@$data)
1146	{
1147	&::log(sprintf("%6d %14s\n", $_->[0], ($_->[1] ? 'ON' : 'Off')));
1148	$needs_update = 1 if ($_->[1]);
1149	}
1150	}
1151
1152	$data = $dbh->selectall_arrayref("SELECT chanid,channum,name,useonairguide FROM channel") \|\|
1153	&::log("Database error: " . $dbh->errstr);
1154	if ($data)
1155	{
1156	&::log("\n ID Channel On-Air Guide (EIT)\n".
1157	"------------------------------------------------\n");
1158	foreach (@$data)
1159	{
1160	&::log(sprintf("%5d %4s %-24s %4s\n", $_->[0], $_->[1], $_->[2], ($_->[3] ? 'ON' : 'Off')));
1161	$needs_update = 1 if ($_->[3]);
1162	}
1163	}
1164
1165	if ($needs_update)
1166	{
1167	&::log("\nShepherd would like to disable EIT where it is enabled above.\n");
1168	if (&XMLTV::Ask::ask_boolean("Okay to disable EIT?", 1))
1169	{
1170	$dbh->do("UPDATE capturecard SET dvb_eitscan='0' WHERE 1;") \|\|
1171	&::log("!! Database error: " . $dbh->errstr . "\n");
1172	$dbh->do("UPDATE channel SET useonairguide='0' WHERE 1;") \|\|
1173	&::log("!! Database error: " . $dbh->errstr . "\n");
1174	&::log("MythTV database updated to disable EIT. (May require mythbackend restart to take effect.)\n");
1175	}
1176	else
1177	{
1178	&::log("Not updating MythTV database; EIT remains on.\n");
1179	}
1180	}
1181	else
1182	{
1183	&::log("\nEIT seems to already be disabled; no need to update MythTV database.\n");
1184	}
1185
1186	&::log("\nFinished with EIT.\n\n");
1187
1188	&Shepherd::MythTV::close_connection;
1189
1190	# 5. Create cron job
1191
1192	&::log("Step 5: Creating cron job...\n".
1193	"------\n");
1194	my $oldcronfile = "$::CWD/cron.bak";
1195
1196	my $cmd = "crontab -l > $oldcronfile";
1197
1198	# Response codes: 0==success, 1==empty cron, other==failure
1199	my $response = (system($cmd) >> 8);
1200	my $no_permission = 1 if ($response > 1);
1201
1202	# Some systems (Gentoo) only allow root to run crontab
1203	if ($no_permission)
1204	{
1205	&::log("Error code $response from crontab command; trying again with root permission...\n");
1206	$cmd = "sudo crontab -u `whoami` -l > $oldcronfile";
1207	$response = (system($cmd) >> 8);
1208	if ($response > 1)
1209	{
1210	&::log("Error code $response from crontab. Aborting.\n");
1211	return;
1212	}
1213	&::log("OK: seemed to work.\n\n");
1214	}
1215
1216	my $newcron = '';
1217	my $oldcron = '';
1218	if (open (OLDCRON, $oldcronfile))
1219	{
1220	while (my $line = <OLDCRON>)
1221	{
1222	$oldcron .= $line;
1223	$newcron .= $line unless ($line =~ /mythfilldatabase/);
1224	}
1225	close OLDCRON;
1226	}
1227
1228	my $mythfilldatabase = `which mythfilldatabase`;
1229	unless ($mythfilldatabase)
1230	{
1231	&::log("WARNING! Unable to locate \"mythfilldatabase\". (Is MythTV installed?)\n".
1232	"Proceeding anyway, but cron job may not work.\n\n");
1233	$mythfilldatabase = 'mythfilldatabase';
1234	}
1235	chomp $mythfilldatabase;
1236
1237	my $minute = ((localtime)[1] + 2) % 60;
1238	my $job = "$minute * * * * nice $mythfilldatabase > /dev/null\n";
1239
1240	$newcron .= $job;
1241
1242	my $newcronfile = "$::CWD/cron.new";
1243	open (NEWCRON, ">$newcronfile")
1244	or die "Unable to open $newcronfile: $!";
1245	print NEWCRON $newcron;
1246	close NEWCRON;
1247
1248	if ($response)
1249	{
1250	&::log("Shepherd believes you currently have no crontab, and would\n".
1251	"like to set your crontab to:\n");
1252	}
1253	else
1254	{
1255	&::log("Shepherd would like to replace this:\n\n$oldcron\n" .
1256	"... with this:\n");
1257	}
1258	&::log("\n$newcron\n");
1259	if (!&XMLTV::Ask::ask_boolean("Set your crontab as displayed above?", 1))
1260	{
1261	&::log("Not setting cron job.\n");
1262	}
1263	else
1264	{
1265	$cmd = "crontab $newcronfile";
1266	$cmd = "sudo $cmd -u `whoami`" if ($no_permission);
1267	system($cmd) and &::log("Failed?\n");
1268
1269	&::log("Done.\n");
1270
1271	if (&XMLTV::Ask::ask_boolean("Would you like to see your symlink " .
1272	"and cron job?", 1))
1273	{
1274	my $cmd = "ls -l `which tv_grab_au`";
1275	&::log("\n" . '$ ' . $cmd . "\n");
1276	system($cmd);
1277
1278	$cmd = "crontab -l";
1279	$cmd = "sudo $cmd -u `whoami`" if ($no_permission);
1280	&::log("\n" . '$ ' . $cmd . "\n");
1281	system($cmd);
1282	}
1283
1284	&::log("\nYour system will run mythfilldatabase on the $minute" .
1285	"th minute of every hour.\n");
1286	}
1287
1288	&::log("\nFinished configuring MythTV.\n\n");
1289	}
1290
1291
1292	# Convert callsigns and channel names for matching.
1293	sub munge
1294	{
1295	my $ret = $_[0];
1296
1297	# Convert to upercase.
1298
1299	$ret = uc($ret);
1300
1301	# Substitute numbers for words.
1302
1303	$ret =~s/12/TWELVE/g;
1304	$ret =~s/11/ELEVEN/g;
1305	$ret =~s/10/TEN/g;
1306	$ret =~s/9/NINE/g;
1307	$ret =~s/8/EIGHT/g;
1308	$ret =~s/7/SEVEN/g;
1309	$ret =~s/6/SIX/g;
1310	$ret =~s/5/FIVE/g;
1311	$ret =~s/4/FOUR/g;
1312	$ret =~s/3/THREE/g;
1313	$ret =~s/2/TWO/g;
1314	$ret =~s/1/ONE/g;
1315	$ret =~s/0/ZERO/g;
1316
1317	# Ignore "Digital"
1318
1319	$ret =~s/DIGITAL//g;
1320
1321	# Remove white space.
1322
1323	$ret =~s/[[:space:]]+//g;
1324
1325	# Make HDTV equivalent to HD
1326
1327	$ret =~s/HDTV/HD/g;
1328
1329	# Remove any non alphabetics.
1330
1331	$ret =~s/[^A-Z]//g;
1332
1333	return $ret;
1334	}
1335
1336
1337	# ------------------------------
1338	# - Icons -
1339	# ------------------------------
1340
1341	sub set_icons
1342	{
1343
1344	&::call_prog('add_channel_icons', &::query_filename('add_channel_icons', 'postprocessor') . ' --set-theme');
1345
1346	&::log("Your icon theme choice will be sent to MythTV when Shepherd completes\n" .
1347	"its next full run. They won't show up in MythTV until then.\n\n" .
1348	"Shepherd may use default icons for some channels if your preferred theme\n" .
1349	"does not have one available.\n\n" .
1350	"Done.\n");
1351	}
1352
1353
1354
1355	1;

Note: See TracBrowser for help on using the repository browser.

Download in other formats: