root/shepherd @ 9

Revision 9, 33.8 kB (checked in by lincoln, 7 years ago)

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