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

Last change on this file since 1472 was 1472, checked in by mbarry, 10 years ago

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