* Automatically keep all builds in the latest successful release in

each release set.

src/Hydra/lib/Hydra/Controller/Root.pm

@@ -180,27 +180,6 @@ sub releasesets :Local {
 }
 
 
-sub attrsToSQL {
-    my ($attrs, $id) = @_;
-    my @attrs = split / /, $attrs;
-
-    my $query = "1 = 1";
-
-    foreach my $attr (@attrs) {
-        $attr =~ /^([\w-]+)=([\w-]*)$/ or die "invalid attribute in release set: $attr";
-        my $name = $1;
-        my $value = $2;
-        # !!! Yes, this is horribly injection-prone... (though
-        # name/value are filtered above).  Should use SQL::Abstract,
-        # but it can't deal with subqueries.  At least we should use
-        # placeholders.
-        $query .= " and (select count(*) from buildinputs where build = $id and name = '$name' and value = '$value') = 1";
-    }
-
-    return $query;
-}
-
-
 sub getReleaseSet {
     my ($c, $projectName, $releaseSetName) = @_;
     
@@ -215,62 +194,12 @@ sub getReleaseSet {
     (my $primaryJob) = $releaseSet->releasesetjobs->search({isprimary => 1});
     #die "Release set $releaseSetName doesn't have a primary job." if !defined $primaryJob;
 
-    $c->stash->{jobs} = [$releaseSet->releasesetjobs->search({},
+    my $jobs = [$releaseSet->releasesetjobs->search({},
         {order_by => ["isprimary DESC", "job", "attrs"]})];
 
-    return ($project, $releaseSet, $primaryJob);
+    $c->stash->{jobs} = $jobs;
-}
 
-
+    return ($project, $releaseSet, $primaryJob, $jobs);
-sub getRelease {
-    my ($c, $primaryBuild) = @_;
-    
-    my @jobs = ();
-
-    my $status = 0; # = okay
-
-    # The timestamp of the release is the highest timestamp of all
-    # constitutent builds.
-    my $timestamp = 0;
-        
-    foreach my $job (@{$c->stash->{jobs}}) {
-        my $thisBuild;
-
-        if ($job->isprimary) {
-            $thisBuild = $primaryBuild;
-        } else {
-            # Find a build of this job that had the primary build
-            # as input.  If there are multiple, prefer successful
-            # ones, and then oldest.  !!! order_by buildstatus is hacky
-            ($thisBuild) = $primaryBuild->dependentBuilds->search(
-                { attrname => $job->job, finished => 1 },
-                { join => 'resultInfo', rows => 1
-                , order_by => ["buildstatus", "timestamp"]
-                , where => \ attrsToSQL($job->attrs, "build.id")
-                });
-        }
-
-        if ($job->mayfail != 1) {
-            if (!defined $thisBuild) {
-                $status = 2 if $status == 0; # = unfinished
-            } elsif ($thisBuild->resultInfo->buildstatus != 0) {
-                $status = 1; # = failed
-            }
-        }
-
-        $timestamp = $thisBuild->timestamp
-            if defined $thisBuild && $thisBuild->timestamp > $timestamp;
-
-        push @jobs, { build => $thisBuild, job => $job };
-    }
-
-    return
-        { id => $primaryBuild->id
-        , releasename => $primaryBuild->get_column('releasename')
-        , jobs => [@jobs]
-        , status => $status
-        , timestamp => $timestamp
-        };
 }
 
 
@@ -308,22 +237,10 @@ sub updateReleaseSet {
 }
 
 
-sub getPrimaryBuildsForReleaseSet {
-    my ($project, $primaryJob) = @_;
-    my @primaryBuilds = $project->builds->search(
-        { attrname => $primaryJob->job, finished => 1 },
-        { join => 'resultInfo', order_by => "timestamp DESC"
-        , '+select' => ["resultInfo.releasename"], '+as' => ["releasename"]
-        , where => \ attrsToSQL($primaryJob->attrs, "me.id")
-        });
-    return @primaryBuilds;
-}
-
-    
 sub releases :Local {
     my ($self, $c, $projectName, $releaseSetName, $subcommand) = @_;
 
-    my ($project, $releaseSet, $primaryJob) = getReleaseSet($c, $projectName, $releaseSetName);
+    my ($project, $releaseSet, $primaryJob, $jobs) = getReleaseSet($c, $projectName, $releaseSetName);
 
     if (defined $subcommand && $subcommand ne "") {
 
@@ -357,7 +274,7 @@ sub releases :Local {
     $c->stash->{template} = 'releases.tt';
 
     my @releases = ();
-    push @releases, getRelease($c, $_) foreach getPrimaryBuildsForReleaseSet($project, $primaryJob);
+    push @releases, getRelease($_, $jobs) foreach getPrimaryBuildsForReleaseSet($project, $primaryJob);
     $c->stash->{releases} = [@releases];
 }
 
@@ -400,20 +317,12 @@ sub release :Local {
     my ($self, $c, $projectName, $releaseSetName, $releaseId) = @_;
     $c->stash->{template} = 'release.tt';
 
-    my ($project, $releaseSet, $primaryJob) = getReleaseSet($c, $projectName, $releaseSetName);
+    my ($project, $releaseSet, $primaryJob, $jobs) = getReleaseSet($c, $projectName, $releaseSetName);
 
     if ($releaseId eq "latest") {
         # Redirect to the latest successful release.
-        my $latest;
+        my $latest = getLatestSuccessfulRelease($project, $primaryJob, $jobs);
-        foreach my $release (getPrimaryBuildsForReleaseSet($project, $primaryJob)) {
-            if (getRelease($c, $release)->{status} == 0) {
-                $latest = $release;
-                last;
-            }
-        }
-
         return error($c, "This release set has no successful releases yet.") if !defined $latest;
-
         return $c->res->redirect($c->uri_for("/release", $projectName, $releaseSetName, $latest->id));
     }
     
@@ -423,7 +332,7 @@ sub release :Local {
         { join => 'resultInfo', '+select' => ["resultInfo.releasename"], '+as' => ["releasename"] });
     return error($c, "Release $releaseId doesn't exist.") if !defined $primaryBuild;
     
-    $c->stash->{release} = getRelease($c, $primaryBuild);
+    $c->stash->{release} = getRelease($primaryBuild, $jobs);
 }
 
 

src/Hydra/lib/Hydra/Helper/Nix.pm

@@ -5,7 +5,9 @@ use Exporter;
 use File::Basename;
 
 our @ISA = qw(Exporter);
-our @EXPORT = qw(isValidPath getHydraPath getHydraDBPath openHydraDB);
+our @EXPORT = qw(
+    isValidPath getHydraPath getHydraDBPath openHydraDB
+    getPrimaryBuildsForReleaseSet getRelease getLatestSuccessfulRelease );
 
 
 sub isValidPath {
@@ -40,4 +42,100 @@ sub openHydraDB {
 }
 
 
+sub attrsToSQL {
+    my ($attrs, $id) = @_;
+    my @attrs = split / /, $attrs;
+
+    my $query = "1 = 1";
+
+    foreach my $attr (@attrs) {
+        $attr =~ /^([\w-]+)=([\w-]*)$/ or die "invalid attribute in release set: $attr";
+        my $name = $1;
+        my $value = $2;
+        # !!! Yes, this is horribly injection-prone... (though
+        # name/value are filtered above).  Should use SQL::Abstract,
+        # but it can't deal with subqueries.  At least we should use
+        # placeholders.
+        $query .= " and (select count(*) from buildinputs where build = $id and name = '$name' and value = '$value') = 1";
+    }
+
+    return $query;
+}
+
+
+sub getPrimaryBuildsForReleaseSet {
+    my ($project, $primaryJob) = @_;
+    my @primaryBuilds = $project->builds->search(
+        { attrname => $primaryJob->job, finished => 1 },
+        { join => 'resultInfo', order_by => "timestamp DESC"
+        , '+select' => ["resultInfo.releasename"], '+as' => ["releasename"]
+        , where => \ attrsToSQL($primaryJob->attrs, "me.id")
+        });
+    return @primaryBuilds;
+}
+
+
+sub getRelease {
+    my ($primaryBuild, $jobs) = @_;
+    
+    my @jobs = ();
+
+    my $status = 0; # = okay
+
+    # The timestamp of the release is the highest timestamp of all
+    # constitutent builds.
+    my $timestamp = 0;
+        
+    foreach my $job (@{$jobs}) {
+        my $thisBuild;
+
+        if ($job->isprimary) {
+            $thisBuild = $primaryBuild;
+        } else {
+            # Find a build of this job that had the primary build
+            # as input.  If there are multiple, prefer successful
+            # ones, and then oldest.  !!! order_by buildstatus is hacky
+            ($thisBuild) = $primaryBuild->dependentBuilds->search(
+                { attrname => $job->job, finished => 1 },
+                { join => 'resultInfo', rows => 1
+                , order_by => ["buildstatus", "timestamp"]
+                , where => \ attrsToSQL($job->attrs, "build.id")
+                });
+        }
+
+        if ($job->mayfail != 1) {
+            if (!defined $thisBuild) {
+                $status = 2 if $status == 0; # = unfinished
+            } elsif ($thisBuild->resultInfo->buildstatus != 0) {
+                $status = 1; # = failed
+            }
+        }
+
+        $timestamp = $thisBuild->timestamp
+            if defined $thisBuild && $thisBuild->timestamp > $timestamp;
+
+        push @jobs, { build => $thisBuild, job => $job };
+    }
+
+    return
+        { id => $primaryBuild->id
+        , releasename => $primaryBuild->get_column('releasename')
+        , jobs => [@jobs]
+        , status => $status
+        , timestamp => $timestamp
+        };
+}
+
+
+sub getLatestSuccessfulRelease {
+    my ($project, $primaryJob, $jobs) = @_;
+    my $latest;
+    foreach my $build (getPrimaryBuildsForReleaseSet($project, $primaryJob)) {
+        return $build if getRelease($build, $jobs)->{status} == 0;
+    }
+    return undef;
+    
+}
+
+    
 1;

src/Hydra/script/hydra_update_gc_roots.pl

@@ -44,14 +44,16 @@ sub keepBuild {
 }
 
 
-# Go over all jobs in all projects.
+# Go over all projects.
 
 foreach my $project ($db->resultset('Projects')->all) {
 
+    # Go over all jobs in this project.
+
     foreach my $job ($project->builds->search({},
         {select => [{distinct => 'attrname'}], as => ['attrname']}))
     {
-        print "*** looking for builds to keep in ", $project->name, ":", $job->attrname, "\n";
+        print "*** looking for builds to keep in job ", $project->name, ":", $job->attrname, "\n";
 
         # Keep the N most recent successful builds for each job and
         # platform.
@@ -66,7 +68,26 @@ foreach my $project ($db->resultset('Projects')->all) {
             });
         
         keepBuild $_ foreach @recentBuilds;
+
     }
+
+    # Go over all releases in this project.
+
+    foreach my $releaseSet ($project->releasesets->all) {
+        print "*** looking for builds to keep in release set ", $project->name, ":", $releaseSet->name, "\n";
+
+        (my $primaryJob) = $releaseSet->releasesetjobs->search({isprimary => 1});
+        my $jobs = [$releaseSet->releasesetjobs->all];
+
+        # Keep all builds belonging to the most recent successful release.
+        my $latest = getLatestSuccessfulRelease($project, $primaryJob, $jobs);
+        if (defined $latest) {
+            print "keeping latest successful release ", $latest->id, " (", $latest->get_column('releasename'), ")\n";
+            my $release = getRelease($latest, $jobs);
+            keepBuild $_->{build} foreach @{$release->{jobs}};
+        }
+    }
+    
 }