Changeset 36

Timestamp:

10/07/06 16:15:12 (7 years ago)

Author:

max

Message:

Some more intelli-random grabber selection order.

Files:

• shepherd (modified) (4 diffs)
• shepherd.sample.conf (added)

shepherd

@@ -119 +119 @@
 my $config_file =   "$CWD/$progname.conf";
 my $channels_file = "$CWD/channels.conf";
-my $days;
+my $days = 7;
 
 # postprocessing
@@ -322 +322 @@
     my $total = score_grabbers();
 
-    print "Scoring unused valid grabbers:\n" . Dumper($gscore);
+    return undef unless ($total);
+
+    if ($debug)
+    {
+        print "Grabber selection probabilities:\n";
+        foreach (keys %$gscore)
+        {
+            printf "%15s %6.1f%% %12s\n", 
+                   $_, 100 * $gscore->{$_} / $total, "($gscore->{$_} pts)";
+        }
+    }
 
     return undef unless (scalar keys %$gscore);
@@ -332 +342 @@
     foreach (keys %$gscore)
     {
+        next if (!$gscore->{$_});
         if ($r >= $c and $r < ($c + $gscore->{$_}))
         {
             delete $gscore->{$_};
+            print "Selected $_.\n" if ($debug);
             return $_;
         }
@@ -344 +356 @@
 sub score_grabbers
 {
-    my ($score, $total);
-    foreach (keys %$gscore)
-    {
-        $score = 10;
-        $gscore->{$_} = $score;
+    my ($score, $total, $niceness, $granularity, $m);
+
+    my $missing = detect_missing_data();
+
+    foreach my $grabber (keys %$gscore)
+    {
+        # for each slot, say whether we can fill it or not -- that is,
+        # whether we support this channel and this day #.
+        
+        my $hits = 0;
+        foreach (@$missing)
+        {
+            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 = $grabbers->{$grabber}->{config}->{niceness};
+        unless ($niceness)
+        {
+            print "WARNING: Grabber $grabber has no niceness support " .
+                  "specified in config.\n";
+            $niceness = 5;
+        }
+        $granularity = $grabbers->{$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";
+        $gscore->{$grabber} = $score;
         $total += $score;
     }
     return $total;
+}
+
+sub can_support_channel
+{
+    my ($grabber, $ch) = @_;
+
+    my $channels_supported = $grabbers->{$grabber}->{config}->{channels};
+    unless (defined $channels_supported)
+    {
+        print "WARNING: Grabber $grabber has no channel support " .
+              "specified in config.\n";
+        $channels_supported = '';
+    }
+
+    return 1 unless ($channels_supported); # Empty string means we support all
+    
+    my $match = ($channels_supported =~ /\b$ch\b/);
+#    $match ||= 0;
+    my $exceptions = ($channels_supported =~/^-/);
+#    $exceptions ||= 0;
+#       print "M: " . Dumper ($match) . "E:" . Dumper ($exceptions) . "\n";
+#    print "Can $grabber support channel $ch: " . ($match != $exceptions ? 1 : 0) . 
+        #      " (match $match, exceptions: $exceptions).\n";
+    return ($match != $exceptions);
+}
+
+sub can_support_day
+{
+    my ($grabber, $day) = @_;
+
+    my $days_supported = $grabbers->{$grabber}->{config}->{max_days};
+    unless ($days_supported)
+    {
+        print "WARNING: Grabber $grabber has no max_days support " .
+              "specified in config.\n";
+        $days_supported = 2;
+    }
+#    print "Can $grabber support day $day: " . ($day <= $days_supported) . ".\n";
+    return $day <= $days_supported;
+}
+
+# 
+# Build a little hash of what channel/day data we're currently missing.
+# I think granularity of one day is good for now; could possibly be
+# made more fine-grained if we think grabbers will support that.
+#
+sub detect_missing_data
+{
+    my @missing;
+
+    my $timeslots_per_day = (24 * 60 * 60) / $timeslot_size;
+
+    foreach my $ch (keys %$channels)
+    {
+        if (defined $channel_data->{$ch})
+        {
+            my $slotnum;
+            for ($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";
+                    $slotnum += $timeslots_per_day -
+                                ($slotnum % $timeslots_per_day);
+
+                }
+            }
+        }
+        else
+        {
+            for my $i (1 .. $days)
+            {
+                push (@missing, "$ch:$i");
+            }
+        }
+
+    }
+
+    print "Need data for @missing.\n" if ($debug);
+    return \@missing;
 }