Changeset 84

Timestamp:

10/17/06 02:28:15 (7 years ago)

Author:

max

Message:

Some more code for intelligent-yet-randomish grabber ordering, including support for grabbing timeslices (only particular days and/or channels)

Files:

• shepherd (modified) (15 diffs)

shepherd

@@ -30 +30 @@
 #           data sources like IceTV
 
-BEGIN { *CORE::GLOBAL::die = \&my_die; }
+#BEGIN { *CORE::GLOBAL::die = \&my_die; }
 
 use strict;
@@ -44 +44 @@
 use POSIX qw(strftime);
 use Time::HiRes qw(gettimeofday tv_interval);
+use Algorithm::Diff;
 
 # ---------------------------------------------------------------------------
@@ -89 +90 @@
 my $channels_file = "$CWD/channels.conf";
 my $days = 7;
+my $timeslice;
 
 # postprocessing
@@ -238 +240 @@
         my $comm = "$CWD/grabbers/$grabber/$grabber " .
                    "--region $region " .
-                   "--channels_file $channels_file " .
                    "--output $output";
 
-        # NOTE: ideally a grabber could be instructed to fetch partial data through --channel, --starttime & --endtime
-        # we don't have that for now so instead whenever there is missing data, ALL 7 days for all channels will be collected
-        # FIXME FUTURE: call grabbers just with what we want...
-        $comm .= " --days $days" if ($days);
-        $comm .= " --offset $opt->{offset}" if ($opt->{offset});
+        # Category 1 grabbers (i.e. slow ones) are requested to only fetch the timeslice
+        # that we need. Category 2 grabbers are requested to get everything, since there's
+        # very little cost in grabbing that extra data, and we can use it in the reconciler
+        # to verify that everything looks OK.
+        if ($components->{$grabber}->{config}->{category} == 1)
+        {
+            print "CAT1 grabber: grabbing timeslice.\n";
+            if ($timeslice->{start} != 1)
+            {
+                $comm .= " " . 
+                         $components->{$grabber}->{config}->{option_offset} .
+                         " " .
+                         ($timeslice->{start} - 1);
+            }
+
+            my $n = $timeslice->{stop};
+            if ($timeslice->{start} != 1 
+                    and 
+                !$components->{$grabber}->{config}->{option_offset_eats_days})
+            {
+                $n -= $timeslice->{start};
+            }
+            $comm .= " " .
+                     $components->{$grabber}->{config}->{option_days} .
+                     " " . 
+                     $n;
+            
+            # Write a temporary channels file specifying only the channels we want
+            my $tmpchans;
+            foreach (@{$timeslice->{chans}})
+            {
+                $tmpchans->{$_} = $channels->{$_};
+            }
+            my $tmpcf = "$CWD/channels.conf.tmp";
+            write_file($tmpcf, 'temporary channels', [ $tmpchans ], [ 'channels' ]);
+            $comm .= " --channels_file $tmpcf";
+        }
+        else
+        {
+            $comm .= " --days $days" if ($days);
+            $comm .= " --offset $opt->{offset}" if ($opt->{offset});
+            $comm .= " --channels_file $channels_file";
+        }
         $comm .= " --debug" if ($debug);
         $comm .= " @ARGV" if (@ARGV);
@@ -283 +322 @@
 }
 
+# 
+# 1. If set order, run them in that order
+# 2. If first time ever run, run the transition grabber
+# 3. Randomly select a grabber with a bias towards efficient and high-quality ones
+#
 sub choose_grabber
 {
@@ -292 +336 @@
             {
                 $gscore->{$_} = 0;
+# Cache stuff: not enabled yet
+#               if ($components->{$_}->{config}->{category} == 1
+#                       and
+#                   $components->{$_}->{config}->{cache})
+#               {
+#                   $gscore->{$_ . ' [cache]'} = 0;
+#               }
             }
         }
@@ -308 +359 @@
     # score grabbers
     my $total = score_grabbers();
-
     return undef unless ($total);
-
+    
     if ($debug)
     {
         print "Grabber selection probabilities:\n";
-        foreach (keys %$gscore)
+        foreach (sort { $gscore->{$b} <=> $gscore->{$a} } keys %$gscore)
         {
-            printf "%15s %6.1f%% %12s\n", 
+            printf "%25s %6.1f%% %12s\n", 
                    $_, 100 * $gscore->{$_} / $total, "($gscore->{$_} pts)";
         }
@@ -326 +376 @@
 
     my $c = 0;
-    foreach (keys %$gscore)
-    {
-        next if (!$gscore->{$_});
-        if ($r >= $c and $r < ($c + $gscore->{$_}))
+    foreach my $grabber (keys %$gscore)
+    {
+        next if (!$gscore->{$grabber});
+        if ($r >= $c and $r < ($c + $gscore->{$grabber}))
         {
-            delete $gscore->{$_};
-            print "Selected $_.\n" if ($debug);
-            return $_;
-        }
-        $c += $gscore->{$_};
+            delete $gscore->{$grabber};
+            print "Selected $grabber.\n" if ($debug);
+            if ($grabber =~ /(.*) \[cache\]/)
+            {
+                return $1;
+            }
+            else
+            {
+                if ($components->{$grabber}->{config}->{category} == 2)
+                {
+                    # We might want to run C1 grabbers multiple times
+                    # to grab various timeslices, but not C2 grabbers,
+                    # which should get everything at once.
+                    delete $gscore->{$grabber};
+                }
+                return $grabber;
+            }
+        }
+        $c += $gscore->{$grabber};
     }
     die "ERROR: failed to choose grabber.";
 }
 
+# ****************************************
+# Scoring grabbers:
+#
+# Earn points for each slot you can fill
+# Multipliers:
+# * C2 grabbers
+# * C1 grabbers that have the data we're looking for cached
+# * High 'quality' grabbers get a BIG bonus: low-quals should basically 
+#   not run unless we need them
+# ****************************************
 sub score_grabbers
 {
-    my ($score, $total, $niceness, $granularity, $m);
+    my ($score, $total, $niceness, $granularity, $day, $hits, $cat, $dq, $mult);
 
     my $missing = detect_missing_data();
 
+    calculate_best_timeslice($missing);
+    
+    print "Best timeslice: " . Dumper($timeslice) . "\n" if ($debug);
+
+    my $missing_slice = create_missing_slice();
+
+    # So! Compare C2 grabbers against the raw missing file, because we'll get
+    # everything. But compare C1 grabbers against the timeslice, because we'll
+    # only ask them for a slice. This goes for the [cache] and regular C1s.
     foreach my $grabber (keys %$gscore)
     {
@@ -351 +434 @@
         # whether we support this channel and this day #.
         
-        my $hits = 0;
-        foreach (@$missing)
+        $hits = 0;
+
+        if ($grabber =~ /(.*) \[cache\]$/)
         {
-            my ($ch, $day) = split(/:/);
-            my $result = (can_support_channel($grabber, $ch)
-                          and
-                          can_support_day($grabber, $day));
-            $hits += $result;
-#           print "$grabber vs $ch:$day: " . ($result ? "OK" : "no") . "\n";
-        }
-        $niceness = $components->{$grabber}->{config}->{niceness};
-        unless ($niceness)
+            $hits = find_cache_hits($1, $missing);
+            $cat = 2;
+            $dq = $components->{$1}->{config}->{quality};
+        }
+        else
         {
-            print "WARNING: Grabber $grabber has no niceness support " .
-                  "specified in config.\n";
-            $niceness = 5;
-        }
-        $granularity = $components->{$grabber}->{config}->{granularity};
-        unless (defined $granularity)
-        {
-            print "WARNING: Grabber $grabber has no granularity support " .
-                "specified in config.\n";
-            $granularity = '';
-        }
-        # TODO: use granularity more intelligently ('c' vs 'd') -- Max.
-        $granularity = length ($granularity);
-        my $total_channeldays = $days * scalar (keys %$channels);
-        $granularity *= int((($total_channeldays - 1 ) / scalar(@$missing))/2);
-
-        $score = $hits * ($niceness + $granularity);
-        print "Grabber $grabber can fill $hits empty slots with $niceness niceness and $granularity granularity: scoring $score pts.\n";
+            my $key = $missing;
+            if ($components->{$grabber}->{config}->{category} == 1)
+            {
+                $key = $missing_slice;
+            }
+            foreach my $day (sort keys %$key)
+            {
+                my $val = supports_day($grabber, $day);
+                next unless ($val);
+                print "Day $day:";
+                foreach my $ch (@{$key->{$day}})
+                {
+                    if (supports_channel($grabber, $ch))
+                    {
+                        print " $ch";
+                        $hits += $val;
+                    }
+                }
+                print "\n";
+                $hits = 1 if ($hits > 0 and $hits < 1);
+
+                $cat = $components->{$grabber}->{config}->{category};
+                unless ($cat)
+                {
+                    print "WARNING: Grabber $grabber has no category support ".
+                    "in config.\n";
+                    $cat = 1;
+                }
+
+                $dq = $components->{$grabber}->{config}->{quality};
+                unless ($dq)
+                {
+                    print "WARNING: Grabber $grabber has no quality support ".
+                    "in config.\n";
+                    $dq = 1;
+                }
+            }
+        }
+        $mult = 1;
+        $mult++ if ($cat == 2);
+        $mult *= 2 ** ($dq-1);
+
+        $score = int($hits * $mult);
+        print "Grabber $grabber can fill $hits slots with multiplier $mult (cat: $cat, dq: $dq): scoring $score pts.\n";
         $gscore->{$grabber} = $score;
         $total += $score;
@@ -388 +494 @@
 }
 
-sub can_support_channel
+sub supports_channel
 {
     my ($grabber, $ch) = @_;
@@ -407 +513 @@
 }
 
-sub can_support_day
+sub supports_day
 {
     my ($grabber, $day) = @_;
 
-    my $days_supported = $components->{$grabber}->{config}->{max_days};
-    unless ($days_supported)
-    {
-        print "WARNING: Grabber $grabber has no max_days support " .
-              "specified in config.\n";
-        $days_supported = 2;
-    }
-    return $day <= $days_supported;
+    return 0 unless ($day <= $components->{$grabber}->{config}->{max_days});
+    return 0.5 if ($day > $components->{$grabber}->{config}->{max_reliable_days});
+    return 1;
+}
+
+sub find_cache_hits
+{
+    my ($grabber, $missing) = @_;
+
+    return 5;
 }
 
@@ -428 +536 @@
 sub detect_missing_data
 {
-    my @missing;
+    my $missing = { };
 
     my $timeslots_per_day = (24 * 60 * 60) / $timeslot_size;
@@ -436 +544 @@
         if (defined $channel_data->{$ch})
         {
-            my $slotnum;
-            for ($slotnum = 0; $slotnum < $num_timeslots-1; $slotnum++) 
+            for (my $slotnum = 0; $slotnum < $num_timeslots-1; $slotnum++) 
             {
                 if (!@{$channel_data->{$ch}->{timeslots}}[$slotnum])
                 {
                     my $day = int($slotnum / $timeslots_per_day) + 1;
-                    push @missing, "$ch:$day";
+                    push @{$missing->{$day}}, $ch;
                     $slotnum += $timeslots_per_day -
                                 ($slotnum % $timeslots_per_day);
@@ -451 +558 @@
         else
         {
-            for my $i (1 .. $days)
+            for my $day (1 .. $days)
             {
-                push (@missing, "$ch:$i");
-            }
-        }
-
-    }
-
-    print "Need data for @missing.\n" if ($debug);
-    return \@missing;
-}
-
+                push @{$missing->{$day}}, $ch;
+            }
+        }
+
+    }
+
+    foreach my $day (keys %$missing)
+    {
+        $missing->{$day} = [ sort @{$missing->{$day}} ];
+    }
+
+    if ($debug)
+    {
+        print "Need data for days " . join(", ", sort keys %$missing) . ".\n";
+    }
+    return $missing;
+}
+
+sub calculate_best_timeslice
+{
+    my $missing = shift;
+
+    my ($overlap, $a);
+    $timeslice = { 'chandays' => 0 };
+    foreach my $day (1 .. $days)
+    {
+        consider_slice($day, $day, @{$missing->{$day}});
+        $overlap = $missing->{$day};
+        foreach my $nextday (($day + 1) .. $days)
+        {
+            last unless ($missing->{$nextday});
+            $a = Algorithm::Diff::LCS($overlap, $missing->{$nextday});
+            # print "Overlap: " . Dumper($a);
+            last unless ($a and @{$a});
+            consider_slice($day, $nextday, @{$a});
+            $overlap = $a;
+        }
+    }
+}
+
+sub consider_slice
+{
+    my ($startday, $stopday, @chans) = @_;
+
+    my $challenger = ($stopday - $startday + 1) * scalar(@chans);
+    return unless ($challenger > $timeslice->{chandays});
+
+    # We have a winner!
+    $timeslice->{start} = $startday;
+    $timeslice->{stop} = $stopday;
+    $timeslice->{chans} = [ @chans ];
+    $timeslice->{chandays} = $challenger;
+}
+
+sub create_missing_slice
+{
+    my $ret;
+
+    foreach my $day ($timeslice->{start} .. $timeslice->{stop})
+    {
+        $ret->{$day} = [ @{$timeslice->{chans}} ];
+    }
+    return $ret;
+}
 
 # interpret xmltv data from this grabber/postprocessor
@@ -1250 +1411 @@
 sub write_config_file
 {
-    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";
-    print CONF Data::Dumper->Dump(
+    write_file($config_file, 'configuration', 
         [$region,  $pref_order,  $mirror_site,  $components, $title_translation_table  ],
         ["region", "pref_order", "mirror_site", "components", "title_translation_table" ]);
-    close CONF;
-    print "\nUpdated configuration file $config_file.\n" if ($debug);
 }
 
 sub write_channels_file
 {
-    open(CHAN, ">$channels_file") or die "cannot write to $channels_file: $!";
-    print CHAN Data::Dumper->Dump([$channels], ["channels"]);
-    close CHAN;
-    print "Updated channels file $channels_file.\n" if ($debug);
+    write_file($channels_file, 'channels', [ $channels ], [ 'channels' ]);
+}
+
+sub write_file
+{
+    my ($fn, $name, $vars, $varnames) = @_;
+    open (FN, ">$fn") or die "Can't write to $name file $fn: $!";
+    print FN Data::Dumper->Dump($vars, $varnames);
+    close FN;
+    print "Wrote $name file $fn.\n" if ($debug);
 }