Rename hydra_*.pl to hydra-*

The underscores are ugly and the .pl extension is an implementation
detail that shouldn't be visible to the outside.

Also, get rid of the *.in files.  It's not really necessary to
generate them.  And I was always modifying the wrong file.

src/script/hydra-update-gc-roots

@@ -0,0 +1,143 @@
+#! /var/run/current-system/sw/bin/perl -w
+
+use strict;
+use File::Path;
+use File::Basename;
+use Nix::Store;
+use Hydra::Schema;
+use Hydra::Helper::Nix;
+use POSIX qw(strftime);
+
+my $db = openHydraDB;
+
+
+my %roots;
+
+sub registerRoot {
+    my ($path) = @_;
+    Hydra::Helper::Nix::registerRoot($path);
+    $roots{$path} = 1;
+}
+
+
+sub keepBuild {
+    my ($build) = @_;
+    print STDERR "  keeping build ", $build->id, " (",
+        $build->system, "; ",
+        strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
+    if (isValidPath($build->outpath)) {
+        registerRoot $build->outpath;
+    } else {
+        print STDERR "warning: output ", $build->outpath, " has disappeared\n";
+    }
+}
+
+
+# Go over all projects.
+
+foreach my $project ($db->resultset('Projects')->all) {
+
+    # Go over all jobsets in this project.
+    foreach my $jobset ($project->jobsets->all) {
+        my $keepnr = $jobset->keepnr;
+
+        # If the jobset has been disabled for more than one week, than
+        # don't keep its builds anymore.
+        if ($jobset->enabled == 0 && (time() - $jobset->lastcheckedtime > (7 * 24 * 3600))) {
+            print STDERR "*** skipping disabled jobset ", $project->name, ":", $jobset->name, "\n";
+            next;
+        }
+
+        if ($keepnr <= 0 ) {
+            print STDERR "*** jobset ", $project->name, ":", $jobset->name, " set to keep 0 builds\n";
+            next;
+        }
+
+        # Go over all jobs in this jobset.
+        foreach my $job ($jobset->jobs->all) {
+            print STDERR "*** looking for builds to keep in job ",
+                $project->name, ":", $job->jobset->name, ":", $job->name, "\n";
+
+            # Keep the N most recent successful builds for each job
+            # and platform.
+            # !!! Take time into account? E.g. don't delete builds
+            # that are younger than N days.
+            my @systems = $job->builds->search({ }, { select => ["system"], distinct => 1 })->all;
+            foreach my $system (@systems) {
+                my @recentBuilds = $job->builds->search(
+                    { finished => 1
+                    , buildStatus => 0 # == success
+                    , system => $system->system
+                    },
+                    { join => 'resultInfo'
+                    , order_by => 'me.id DESC'
+                    , rows => $keepnr
+                    });
+                keepBuild $_ foreach @recentBuilds;
+           }
+        }
+    }
+
+    # Go over all views in this project.
+    foreach my $view ($project->views->all) {
+        print STDERR "*** looking for builds to keep in view ", $project->name, ":", $view->name, "\n";
+
+        (my $primaryJob) = $view->viewjobs->search({isprimary => 1});
+        my $jobs = [$view->viewjobs->all];
+
+        # Keep all builds belonging to the most recent successful view result.
+        my $latest = getLatestSuccessfulViewResult($project, $primaryJob, $jobs);
+        if (defined $latest) {
+            print STDERR "keeping latest successful view result ", $latest->id, " (", $latest->get_column('releasename'), ")\n";
+            my $result = getViewResult($latest, $jobs);
+            keepBuild $_->{build} foreach @{$result->{jobs}};
+        }
+    }
+
+    # Keep every build in every release in this project.
+    print STDERR "*** keeping releases in project ", $project->name, "\n"
+        if scalar $project->releases > 0;
+    foreach my $release ($project->releases->all) {
+        print STDERR "keeping release ", $release->name, "\n";
+        keepBuild $_->build foreach $release->releasemembers;
+    }
+}
+
+
+# Keep all builds that have been marked as "keep".
+print STDERR "*** looking for kept builds\n";
+my @buildsToKeep = $db->resultset('Builds')->search({finished => 1, keep => 1}, {join => 'resultInfo'});
+keepBuild $_ foreach @buildsToKeep;
+
+
+# For scheduled builds, we register the derivation as a GC root.
+print STDERR "*** looking for scheduled builds\n";
+foreach my $build ($db->resultset('Builds')->search({finished => 0}, {join => 'schedulingInfo'})) {
+    if (isValidPath($build->drvpath)) {
+        print STDERR "keeping scheduled build ", $build->id, " (",
+            strftime("%Y-%m-%d %H:%M:%S", localtime($build->timestamp)), ")\n";
+        registerRoot $build->drvpath;
+        registerRoot $build->outpath if -e $build->outpath;
+    } else {
+        print STDERR "warning: derivation ", $build->drvpath, " has disappeared\n";
+    }
+}
+
+
+# Remove existing roots that are no longer wanted.  !!! racy
+print STDERR "*** removing unneeded GC roots\n";
+
+my $gcRootsDir = getGCRootsDir;
+
+opendir DIR, $gcRootsDir or die;
+
+foreach my $link (readdir DIR) {
+    next if !-l "$gcRootsDir/$link";
+    my $path = readlink "$gcRootsDir/$link" or die;
+    if (!defined $roots{$path}) {
+        print STDERR "removing root $path\n";
+        unlink "$gcRootsDir/$link" or die "cannot remove $gcRootsDir/$link";
+    }
+}
+
+closedir DIR;