root/shepherd @ 4

Revision 4, 24.1 kB (checked in by max, 7 years ago)

Lincoln's updated XMLTV analysis.
Line 
1#!/usr/bin/perl -w
2
3# "Shepherd"
4
5my $version = '0.2.5ng';
6
7# A wrapper for various Aussie TV guide data grabbers
8#
9# Use --help for command-line options.
10# See shepherd.txt for details.
11#
12#  A current version of this script, plus a README file, might be here:
13#  http://www.whuffy.com/tv_grab_au/
14#
15# Changelog:
16# 0.1.0   : Basic self-updating and grabber management
17# 0.2.0   : --configure
18# 0.2.1   : Has a home in ~/.shepherd/
19# 0.2.2   : --check
20# 0.2.3   : Bugfix: archives correctly
21# 0.2.5ng : multi-grabber (potentially with partial data) & postprocessor support
22#
23# ToDo:
24# * --mirror <url> option, to let you get software from somewhere other
25#   than whuffy. Store this in shepherd.conf. Whuffy is merely the first
26#   mirror.
27# * Make it check compilation after installing by calling --version or
28#   --desc or --ready
29# * --ready  option that says whether config is required?
30# * "Last Data" column in status
31
32use strict;
33use LWP::Simple;
34use Sort::Versions;
35use Cwd;
36use Getopt::Long;
37use Data::Dumper;
38use XMLTV;
39use XMLTV::Ask;
40use DateTime::Format::Strptime;
41
42# ---------------------------------------------------------------------------
43# --- Global Variables
44# ---------------------------------------------------------------------------
45
46my $progname = 'shepherd';
47
48my $HOME = 'http://www.whuffy.com';
49my $STATUS = "$HOME/status";
50
51my $invoked = Cwd::realpath($0);
52
53# By default, Shepherd runs from ~/.shepherd/. If it's not run as a user,
54# it will try /opt/shepherd/ instead.
55my $CWD = ($ENV{HOME} ? $ENV{HOME} . "/." : "/opt/") . $progname;
56-d $CWD or mkdir $CWD or die "Cannot create directory $CWD: $!";
57chdir($CWD);
58
59my $GRABBER_DIR = "$CWD/grabbers";
60my $ARCHIVE_DIR = "$CWD/archive";
61my $timeslot_size = (15 * 60); # 15 minute slots
62my $channel_ok_threshold_percent = 90;
63
64my $opt;
65my $debug = 1;
66my $grabbers = { };
67my $preferred; # obsolete but may still exist in shepherd.conf
68my $region;
69my $channels;
70my $config_file =   "$CWD/$progname.conf";
71my $channels_file = "$CWD/channels.conf";
72my $days;
73
74# postprocessing
75my $langs = [ 'en' ];
76my $num_timeslots;
77my $grabber_data = { };
78my $channel_data = { };
79my $starttime, my $endtime;
80
81# ---------------------------------------------------------------------------
82# --- Setup
83# ---------------------------------------------------------------------------
84
85print ucfirst($progname) . " v$version\n\n";
86#print "Cwd: $CWD.\n";
87
88# Any options Shepherd doesn't understand, we'll pass to the grabber(s)
89Getopt::Long::Configure(qw/pass_through/);
90
91get_initial_command_line_options();
92
93help() if ($opt->{help});
94
95unless ($opt->{configure})
96{
97    read_config_file();
98    read_channels_file();
99}
100
101get_remaining_command_line_options();
102
103if ($opt->{status})
104{
105    status();
106    exit;
107}
108
109if ($opt->{show_config})
110{
111    show_config();
112    exit;
113}
114
115if ($opt->{enable})
116{
117    enable($opt->{enable});
118}
119
120if ($opt->{disable})
121{
122    disable($opt->{disable});
123}
124
125&set_order($opt->{setorder}) if ($opt->{setorder});
126
127if ($opt->{check})
128{
129    check();
130}
131
132if ($opt->{enable} or $opt->{disable} or $opt->{setorder} or $opt->{check})
133{
134    write_config_file();
135    status();
136    exit;
137}
138
139# ---------------------------------------------------------------------------
140# --- Update
141# ---------------------------------------------------------------------------
142
143unless ($opt->{noupdate})
144{
145    update($progname, $version);
146    write_config_file() unless ($opt->{configure});
147}
148
149if ($opt->{configure})
150{
151    configure();
152}
153
154# ---------------------------------------------------------------------------
155# --- Go!
156# ---------------------------------------------------------------------------
157
158unless ($opt->{update})
159{
160    calc_date_range();
161    grab_data();
162}
163
164print "Done.\n";
165
166status();
167
168# ---------------------------------------------------------------------------
169# --- Subroutines
170# ---------------------------------------------------------------------------
171
172# -----------------------------------------
173# Subs: Grabbing
174# -----------------------------------------
175
176sub grab_data
177{
178    my $used_grabbers = 0;
179    my $need_more_data = 1;
180
181    # iterate across grabbers until we have all our data we want (or need)
182    foreach my $grabber (sort { $grabbers->{$a}->{order} <=> $grabbers->{$b}->{order} } keys %$grabbers) {
183        next if ($grabbers->{$grabber}->{disabled});
184        $used_grabbers++;
185
186        $grabber_data->{$grabber}->{last_grabbed} = time;
187
188        printf "SHEPHERD: Using grabber: (%d) %s\n",$grabbers->{$grabber}->{order},$grabber;
189
190        my $output = "$GRABBER_DIR/$grabber/output.xmltv";
191        my $comm = "$GRABBER_DIR/$grabber/$grabber " .
192                   "--region $region " .
193                   "--channels_file $channels_file " .
194                   "--output $output";
195
196        # NOTE: ideally a grabber could be instructed to fetch partial data through --channel, --starttime & --endtime
197        # we don't have that for now so instead whenever there is missing data, ALL 7 days for all channels will be collected
198        # FIXME FUTURE: call grabbers just with what we want...
199        $comm .= " --days $days" if ($days);
200        $comm .= " --offset $opt->{offset}" if ($opt->{offset});
201        $comm .= " --debug" if ($debug);
202        $comm .= " @ARGV" if (@ARGV);
203        print "SHEPHERD: Excuting command: $comm\n";
204
205        chdir "$GRABBER_DIR/$grabber/";
206        system($comm);
207        chdir $CWD;
208
209        # soak up the data we just collected
210        &soak_up_grabber_data($grabber, $output);
211
212        # check to see if we have all the data we want
213        $need_more_data = &analyze_grabber_data();
214
215        last if (!$need_more_data);
216    }
217
218
219    if ($used_grabbers == 0)
220    {
221        print "No valid grabbers installed/enabled!\n";
222        return;
223    }
224
225    if ($need_more_data)
226    {
227        print "SHEPHERD: Ran through ALL grabbers but still missing data!!! :(\n";
228        return;
229    }
230}
231
232
233# interpret xmltv data from this grabber
234sub soak_up_grabber_data
235{
236    my ($grabber, $output) = @_;
237    eval { $grabber_data->{$grabber}->{xmltv} = XMLTV::parsefiles($output); };
238
239    if (defined $grabber_data->{$grabber}->{xmltv}) {
240        $grabber_data->{$grabber}->{valid} = 1;
241
242        my $xmltv = $grabber_data->{$grabber}->{xmltv};
243        my ($encoding, $credits, $chan, $progs) = @$xmltv;
244        $grabber_data->{$grabber}->{total_duration} = 0;
245        $grabber_data->{$grabber}->{programmes} = 0;
246
247        my $strptime = new DateTime::Format::Strptime( pattern => "%Y%m%d%H%M %z");
248        my $seen_channels_with_data = 0;
249
250        # iterate thru channels
251        foreach my $ch (sort keys %{$channels}) {
252            my $seen_progs_on_this_channel = 0;
253
254            # iterate thru programmes per channel
255            foreach my $prog (@$progs) {
256                next if ($prog->{channel} ne $channels->{$ch});
257
258                my $t1 = $strptime->parse_datetime($prog->{start});
259                my $t2 = $strptime->parse_datetime($prog->{stop});
260                next if (!$t1 || !$t2); # if we can't parse stop/start then clearly THIS data is bunk!
261
262                # store grabber-specific stats
263                $grabber_data->{$grabber}->{programmes}++;
264                $grabber_data->{$grabber}->{total_duration} += ($t2->epoch - $t1->epoch);
265                $seen_progs_on_this_channel++;
266                $grabber_data->{$grabber}->{earliest_data_seen} = $t1->epoch if (!defined $grabber_data->{$grabber}->{earliest_data_seen});
267                $grabber_data->{$grabber}->{earliest_data_seen} = $t1->epoch if ($t1->epoch < $grabber_data->{$grabber}->{earliest_data_seen});
268                $grabber_data->{$grabber}->{latest_data_seen} = $t2->epoch if (!defined $grabber_data->{$grabber}->{latest_data_seen});
269                $grabber_data->{$grabber}->{latest_data_seen} = $t2->epoch if ($t2->epoch > $grabber_data->{$grabber}->{latest_data_seen});
270
271                # store channel-specific stats
272                $channel_data->{$ch}->{programmes}++;
273                $channel_data->{$ch}->{total_duration} += ($t2->epoch - $t1->epoch);
274
275                # store timeslot info
276                next if ($t1->epoch > $endtime);        # programme starts after timeslots we are interested .. nice that we have it ... but we really don't care about it!
277                next if ($t2->epoch < $starttime);      # programme ends  before timeslots we are interested .. nice that we have it ... but we really don't care about it!
278                my $start_slotnum;
279                if ($t1->epoch >= $starttime) {
280                    $start_slotnum = int(($t1->epoch - $starttime) / $timeslot_size);
281                } else {
282                    $start_slotnum = 0;
283                }
284                my $end_slotnum;
285                if ($t2->epoch < $endtime) {
286                    $end_slotnum = int(($t2->epoch - $starttime) / $timeslot_size);
287                } else {
288                    $end_slotnum = ($num_timeslots-1);
289                }
290
291                # add this programme into the global timeslots table for this channel
292                foreach my $slotnum ($start_slotnum..$end_slotnum) {
293                    $channel_data->{$ch}->{timeslots}[$slotnum]++;
294                }
295            }
296
297            $seen_channels_with_data++ if ($seen_progs_on_this_channel > 0);
298        }
299
300        # print some stats about what we saw!
301        my $earlist_data_seen = localtime($grabber_data->{$grabber}->{earliest_data_seen});
302        my $latest_data_seen = localtime($grabber_data->{$grabber}->{latest_data_seen});
303        printf "SHEPHERD: Grabber '%s' returned data for %d channels (%d programmes, %dd%02dh%02dm%02ds duration, earliest %s, latest %s)\n",
304            $grabber, $seen_channels_with_data, $grabber_data->{$grabber}->{programmes},
305            int($grabber_data->{$grabber}->{total_duration} / 86400),           # days
306            int(($grabber_data->{$grabber}->{total_duration} % 86400) / 3600),  # hours
307            int(($grabber_data->{$grabber}->{total_duration} % 3600) / 60),     # mins
308            int($grabber_data->{$grabber}->{total_duration} % 60),              # sec
309            $earlist_data_seen, $latest_data_seen;
310    } else {
311        printf "WARNING: Grabber %s didn't seem to return any valid XMLTV!\n",$grabber;
312        delete $grabber_data->{$grabber}->{valid};
313    }
314}
315
316
317# analyze grabber data - do we have all the data we want?
318# returns 1 if we need more data, 0 if we have all we want
319sub analyze_grabber_data
320{
321    my $retval = 0; # until proven otherwise
322    my $total_data_percent = 0, my $total_channels = 0;
323    my $statusstring = "";
324
325    # iterate across each channel
326    foreach my $ch (sort keys %{$channels}) {
327        $total_channels++;
328        if (defined $channel_data->{$ch}) {
329            my $data_in_channel = 0;
330            for my $slotnum (0..($num_timeslots-1)) {
331                $data_in_channel++ if ($channel_data->{$ch}->{timeslots}[$slotnum] > 0);
332            }
333
334            # do we have enough data for this channel?
335            my $data_in_channel_percent = $data_in_channel / ($num_timeslots-1) * 100;
336            if ($data_in_channel_percent >= $channel_ok_threshold_percent) {
337                $statusstring .= sprintf "%s: %0.1f%% [complete], ",$ch,$data_in_channel_percent;
338            } else {
339                $statusstring .= sprintf "%s: %0.1f%% [hungry], ",$ch,$data_in_channel_percent;
340                $retval = 1;
341            }
342            $total_data_percent += $data_in_channel_percent;
343        } else {
344            $statusstring .= sprintf "%s: 0%% [starving], ",$ch;
345            $retval = 1;
346        }
347    }
348
349    if ($total_channels > 0) {
350        $total_data_percent = $total_data_percent / $total_channels;
351    } else {
352        $total_data_percent = 0;
353    }
354
355    # print some stats about what our analysis says!
356    printf "SHEPHERD: ANALYSIS: %sTOTAL %0.2f%% %s %0.2f%%: %s\n", $statusstring, $total_data_percent,
357        ($total_data_percent >= $channel_ok_threshold_percent ? ">" : "<"), $channel_ok_threshold_percent,
358        ($retval ? "WANT MORE DATA" : "COMPLETE");
359    return $retval;
360}
361
362
363# work out date range we are expecting data to be in
364sub calc_date_range
365{
366    # normalize starttime to beginning of hour
367    my $now = time;
368    my ($sec,$min,@rest) = localtime($now);
369
370    $starttime = $now - ((60 * $min) + $sec);
371
372    if ($days) {
373        $endtime = $starttime + ($days * 86400);
374    } else {
375        $endtime = $starttime + (7*86400);
376    }
377    $starttime += (86400 * $opt->{offset}) if ($opt->{offset});
378
379    $num_timeslots = ($endtime - $starttime) / $timeslot_size;
380}
381
382# -----------------------------------------
383# Subs: Updates & Installations
384# -----------------------------------------
385
386sub update
387{
388    print "\nFetching status file: $STATUS.\n";
389    my $data = LWP::Simple::get($STATUS);
390    unless ($data)
391    {
392        print "Failed to retrieve status file.\n";
393        return;
394    }
395
396    my %glist = %$grabbers;
397    while ($data =~ /(.*):(.*)/g)
398    {
399        update_component($1, $2);
400        delete $glist{$1};
401    }
402    foreach (keys %glist)
403    {
404        unless ($grabbers->{$_}->{disabled})
405        {
406            print "\nDeleted grabber: $_.\n";
407            disable($_);
408        }
409    }
410}
411
412sub update_component
413{
414    my ($proggy, $latestversion) = @_;
415
416    print "\n";
417
418    if ($proggy eq $progname)
419    {
420        if(! -e "$CWD/$progname")
421        {
422            print "Missing: $CWD/$progname\n";
423            install($progname, $latestversion);
424            return;
425        }
426    }
427    else
428    {
429        if (!$grabbers->{$proggy} or ! -e "$GRABBER_DIR/$proggy/$proggy")
430        {
431            print "New grabber: $proggy.\n";
432            install($proggy, $latestversion);
433            return;
434        }
435        if ($grabbers->{$proggy}->{disabled})
436        {
437            print "Warning: $proggy disabled by config file.\n";
438        }
439    }
440
441    # Compare versions
442    my $ver = ($proggy eq $progname ? $version : $grabbers->{$proggy}->{ver});
443
444    my $result = versioncmp($ver, $latestversion);
445    if ($result == -1)
446    {
447        print "Upgrading $proggy from v$ver to v$latestversion.\n";
448    }
449    elsif ($result == 1)
450    {
451        print "Downgrading $proggy from v$ver to v$latestversion.\n";
452    }
453    else
454    {
455        print "Already have latest version of $proggy: v$ver.\n";
456        return;
457    }
458    install($proggy, $latestversion);
459}
460
461sub install
462{
463    my ($proggy, $latestversion) = @_;
464
465    print "Downloading $proggy v$latestversion.\n";
466
467    my $rdir = $HOME;
468    my $ldir = $CWD;
469    my $ver = $version;
470
471    if ($proggy ne $progname)
472    {
473        -d $GRABBER_DIR or mkdir $GRABBER_DIR
474            or die "Cannot create directory $GRABBER_DIR: $!";
475
476        $ldir = "$GRABBER_DIR/$proggy";
477        -d $ldir or mkdir $ldir or die "Cannot create directory $ldir: $!";
478        $rdir = "$rdir/grabbers";
479        $ver = $grabbers->{$proggy}->{ver};
480    }
481
482    my $newfile = "$ldir/$proggy-$latestversion";
483   
484    my $rc = LWP::Simple::getstore("$rdir/$proggy-$latestversion", $newfile);
485
486    unless (is_success($rc))
487    {
488        print "Failed to retrieve $rdir/$proggy-$latestversion.\n";
489        return;
490    }
491
492    # Make it executable
493    system('chmod u+x ' . $newfile);
494
495    -d $ARCHIVE_DIR or mkdir $ARCHIVE_DIR
496      or die "Cannot create directory $ARCHIVE_DIR: $!";
497
498    if (-e "$ldir/$proggy")
499    {
500        rename("$ldir/$proggy", "$ARCHIVE_DIR/$proggy-$ver");
501    }
502    rename($newfile, "$ldir/$proggy");
503   
504    print "Installed $proggy v$latestversion.\n" if ($debug);
505
506    if ($proggy eq $progname)
507    {
508        print "\n*** Restarting ***\n\n";
509        exec("$ldir/$proggy");
510        # This exits.
511    }
512
513    print "Testing $proggy...\n" if ($debug);
514    my $result = test_grabber($proggy);
515
516    # Update grabbers list
517    my $disabled = $grabbers->{$proggy}->{disabled};
518    $grabbers->{$proggy} = 
519        { 
520            'ver' => $latestversion, 
521            'disabled' => $disabled,
522            'ready' => $result
523        };
524}
525
526sub test_grabber
527{
528    my $proggy = shift;
529
530    chdir("$GRABBER_DIR/$proggy");
531    system("$GRABBER_DIR/$proggy/$proggy --ready");
532    chdir ($CWD);
533
534    my $result = $?;
535    print "Return value: $result\n" if ($debug);
536
537    if ($result)
538    {
539        print "\nGrabber $proggy did not exit cleanly!\n" .
540              "It may require configuration.\n\n";
541    }
542
543    return !$result;
544}
545
546sub enable
547{
548    my $proggy = shift;
549
550    print "Enabling $proggy.\n";
551    if (!$grabbers->{$proggy})
552    {
553        print "No such grabber: \"$proggy\".\n";
554    }
555    else
556    {
557        delete $grabbers->{$proggy}->{disabled};
558    }
559}
560
561sub disable
562{
563    my $proggy = shift;
564
565    print "Disabling $proggy.\n";
566    $grabbers->{$proggy}->{disabled} = 1;
567}
568
569sub set_order
570{
571    my $order = shift;
572    my $all_ok = 1;
573
574    # first check that user supplied a valid list of grabbers
575    if ($order) {
576        foreach my $proggy (split(/,/,$order)) {
577            next if !$proggy;
578            if (!$grabbers->{$proggy}) {
579                $all_ok = 0;
580                print "Invalid grabber: \"$proggy\".\n";
581            }
582        }
583    }
584    if ($all_ok) {
585        # if list was ok then first reset current order to zero
586        foreach my $proggy (keys %$grabbers) {
587            $grabbers->{$proggy}->{order} = 0;
588        }
589
590        # and now set order
591        my $order_num = 1;
592        if ($order) {
593            foreach my $proggy (split(/,/,$order)) {
594                $grabbers->{$proggy}->{order} = $order_num;
595                $order_num++;
596            }
597        }
598
599        # set order of any grabbers not specified in a random manner
600        foreach my $proggy (sort keys %$grabbers) {
601            if ($grabbers->{$proggy}->{order} == 0) {
602                $grabbers->{$proggy}->{order} = $order_num+int(rand(100));
603            }
604        }
605
606        # .. and finally normalize the order (& show the user the order we chose)
607        print "Grabber order set as follows:\n";
608        $order_num = 0;
609        $opt->{setorder} = "";
610        foreach my $proggy (sort { $grabbers->{$a}->{order} <=> $grabbers->{$b}->{order} } keys %$grabbers) {
611            $order_num++;
612            $grabbers->{$proggy}->{order} = $order_num;
613            $opt->{setorder} .= "$proggy" . ",";
614            printf " #%d. %s%s\n",$grabbers->{$proggy}->{order},$proggy,($grabbers->{$proggy}->{disabled} ? " [disabled]" : "");
615        }
616    }
617}
618
619sub check
620{
621    my $result;
622    foreach (keys %$grabbers)
623    {
624        $result = test_grabber($_);
625        print "Grabber $_: " . 
626              ($result ? "OK" : "Failed") . "\n\n";
627        if (!$result ne !$grabbers->{$_}->{ready})
628        {
629            $grabbers->{$_}->{ready} = $result;
630        }
631    }
632}
633
634# -----------------------------------------
635# Subs: Setup
636# -----------------------------------------
637
638sub read_config_file
639{
640    read_file($config_file, 'configuration');
641
642    # if we are updating from a previous rev of shepherd.conf we may not
643    # have any 'order' fields set .. check here
644    my $found_order = 1;
645    foreach (keys %$grabbers)
646    {
647        $found_order = 0 if (!defined $grabbers->{$_}->{order});
648    }
649    if (($found_order == 0) && (!$opt->{setorder}))
650    {
651        # at least one 'order' was missing .. we need to put it in!
652        printf "Legacy shepherd.conf file didn't contain any grabber order! Automatically updating using a random order, use --setorder to manually set this if you care.\n";
653        &set_order();
654        $opt->{setorder} = "";
655    }
656}
657
658sub read_channels_file
659{
660    read_file($channels_file, 'channels');
661}
662
663sub read_file
664{
665    my $fn = shift;
666    my $name = shift;
667
668    print "Reading $name file: $fn\n";
669    unless (-r $fn)
670    {
671        unless ($opt->{configure})
672        {
673            print "\nNo $name file found.\n" .
674                  ucfirst($progname) . " must be configured: " .
675                  "configuring now.\n\n";
676            $opt->{'configure'} = 1;
677        }
678        return;
679    }
680    local (@ARGV, $/) = ($fn);
681    no warnings 'all';
682    eval <>;
683    if ($@ and !$opt->{configure})
684    {
685        die "\nError in $name file!\nDetails:\n$@";
686    }
687}
688
689sub write_config_file
690{
691    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
692    print CONF Data::Dumper->Dump(
693        [$region,  $grabbers ],
694        ["region", "grabbers" ]);
695    close CONF;
696    print "\nUpdated configuration file $config_file.\n" if ($debug);
697}
698
699sub write_channels_file
700{
701    open(CHAN, ">$channels_file") or die "cannot write to $channels_file: $!";
702    print CHAN Data::Dumper->Dump([$channels], ["channels"]);
703    close CHAN;
704    print "Updated channels file $channels_file.\n" if ($debug);
705}
706
707sub get_initial_command_line_options
708{
709  GetOptions( 'config-file=s'   => \$opt->{configfile},
710              'help'            => \$opt->{help},
711              'configure'       => \$opt->{configure},
712              'debug'           => \$debug);
713}
714
715sub get_remaining_command_line_options
716{
717    GetOptions(
718              'version'         => \$opt->{status},
719              'status'          => \$opt->{status},
720              'list'            => \$opt->{list},
721              'show-config'     => \$opt->{show_config},
722
723              'update'          => \$opt->{update},
724              'noupdate'        => \$opt->{noupdate},
725
726              'disable=s'       => \$opt->{disable},
727              'enable=s'        => \$opt->{enable},
728              'setorder=s'      => \$opt->{setorder},
729
730              'days=i'          => \$days,
731              'offset=i'        => \$opt->{offset},
732              'show-channels'   => \$opt->{show_channels},
733              'output=s'        => \$opt->{output},
734              'check'           => \$opt->{check}
735            );
736}
737
738
739# -----------------------------------------
740# Subs: Configuration
741# -----------------------------------------
742
743sub configure
744{
745    my $REGIONS = {
746        "ACT" => 126,
747        "NSW: Sydney" => 73,
748        "NSW: Newcastle" => 184,
749        "NSW: Central Coast" => 66,
750        "NSW: Griffith" => 67,
751        "NSW: Broken Hill" => 63,
752        "NSW: Northern NSW" => 69,
753        "NSW: Southern NSW" => 71,
754        "NSW: Remote and Central" => 106,
755        "NT: Darwin" => 74,
756        "NT: Remote & Central" => 108,
757        "QLD: Brisbane" => 75,
758        "QLD: Gold Coast" => 78,
759        "QLD: Regional" => 79,
760        "QLD: Remote & Central" => 114,
761        "SA: Adelaide" => 81,
762        "SA: Renmark" => 82,
763        "SA: Riverland" => 83,
764        "SA: South East SA" => 85,
765        "SA: Spencer Gulf" => 86,
766        "SA: Remote & Central" => 107,
767        "Tasmania" => 88,
768        "VIC: Melbourne" => 94,
769        "VIC: Geelong" => 93,
770        "VIC: Eastern Victoria" => 90,
771        "VIC: Mildura/Sunraysia" => 95,
772        "VIC: Western Victoria" => 98,
773        "WA: Perth" => 101,
774        "WA: Regional" => 102
775    };
776
777    print "\nConfiguring.\n\n" .
778          "Select your region:\n";
779    foreach (sort keys %$REGIONS)
780    {
781        printf(" (%3d) %s\n", $REGIONS->{$_}, $_);
782    }
783    $region = ask_choice("Enter region code:", "94", values %$REGIONS);
784
785    print "\nFetching channel information... ";
786
787    my @channellist = get_channels();
788
789    print "done.\n\n" .
790          "For each channel you want guide data for, enter an XMLTV id\n" .
791          "of your choice (e.g. \"seven.free.au\"). If you don't need\n" .
792          "guide data for this channel, just press Enter.\n\n" .
793          "Please don't subscribe to unneeded channels.\n\nChannels:\n";
794    $channels = {};
795    my $line;
796    foreach (@channellist)
797    {
798        $line = ask(" \"$_\"? ");
799        $channels->{$_} = $line if ($line);
800    }
801
802
803    print "\nRandomly selecting grabber order.\n\n";
804    set_order();
805
806    show_channels();
807    unless(ask_boolean("\nCreate configuration file?"))
808    {
809        print "Aborting configuration.\n";
810        exit 0;
811    }
812
813    write_config_file();
814    write_channels_file();
815
816    print "Finished configuring.\n\n" .
817          "Shepherd is installed into $CWD.\n\n";
818   
819    if ($invoked ne "$CWD/$progname" and $invoked =~ /$progname/)
820    {
821        print "Warning: you invoked this program as $invoked.\n" .
822            "In the future, it should be run as $CWD/$progname,\n" .
823            "to avoid constantly re-downloading the latest version.\n\n" .
824            "MythTV users may wish to create the following symlink, by " .
825            "doing this (as root):\n" .
826            "\"ln -s $CWD/$progname /usr/bin/tv_grab_au\".\n\n" .
827            "You may safely delete $invoked.\n\n";
828    }
829
830    status();
831
832    unless (ask_boolean("\nGrab data now?"))
833    {
834        exit 0;
835    }
836}
837
838sub get_channels
839{
840    my @date = localtime;
841    my $page = LWP::Simple::get(
842        "http://au.tv.yahoo.com/results.html?rg=$region&dt=" .
843        ($date[5] + 1900) . "-$date[4]-$date[3]");
844    my @channellist;
845    while ($page =~ /<tr class=rtb><td class=rth><a .*?>(.*?)<\/a>/g)
846    {
847        push @channellist, $1;
848    }
849    return @channellist;
850}
851
852# -----------------------------------------
853# Subs: Status & Help
854# -----------------------------------------
855
856sub show_config
857{
858    print "\nConfiguration\n".
859          "-------------\n" .
860          "Config file: $config_file\n" .
861          "Debug mode : " . is_set($debug) . "\n" .
862          "Output file: " . ($opt->{output} ? $opt->{output} : "None") . "\n" .
863          "Region ID  : $region\n";
864  show_channels();
865  print "\n";
866  status();
867  print "\n";
868}
869
870sub show_channels
871{
872  print "Subscribed channels:\n";
873  print "    $_ -> $channels->{$_}\n" for sort keys %$channels;
874}
875
876sub is_set
877{
878    my $arg = shift;
879    return $arg ? "Yes" : "No";
880}
881
882sub status
883{
884    print " Grabber                     Version  Enabled  Ready    Last Data\n" .
885          " -----------------------------------------------------------------\n";
886    my $star;
887    foreach (sort { $grabbers->{$a}->{order} <=> $grabbers->{$b}->{order} } keys %$grabbers)
888    {
889        my $h = $grabbers->{$_};
890        printf  " %-26s %8s %5s %7s %10s\n",
891                "$h->{order}. $_",
892                $h->{ver},
893                $h->{disabled} ? '' : 'Y',
894                $h->{ready} ? 'Y' : '',
895                $h->{lastdata} ? localtime($h->{lastdata}) : '';
896    }
897
898    printf "Grabbers shown in order of preference.\n";
899}
900
901sub help
902{
903    print q{
904Command-line options:
905    --help                Print this message
906
907    --status              Print a list of grabbers maintained
908    --list                Print a detailed list of grabbers
909
910    --configure           Setup
911    --show-config         Print setup details
912
913    --setorder <s>        Set order of grabbers to <s> (comma-seperated list of grabbers)
914    --disable <s>         Don't ever use grabber <s>
915    --enable <s>          Okay, maybe use it again then
916    --uninstall <s>       Remove a disabled grabber
917
918    --noupdate            Do not attempt to update before running
919    --update              Update only; do not grab data
920
921    --check               Check status of all grabbers
922};
923    exit 0;
924}
Note: See TracBrowser for help on using the browser.