diff --git a/src/Hydra/lib/Hydra/Controller/Root.pm b/src/Hydra/lib/Hydra/Controller/Root.pm index a68d4171..ce6fc9e4 100644 --- a/src/Hydra/lib/Hydra/Controller/Root.pm +++ b/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; - -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 - }; + return ($project, $releaseSet, $primaryJob, $jobs); } @@ -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; - foreach my $release (getPrimaryBuildsForReleaseSet($project, $primaryJob)) { - if (getRelease($c, $release)->{status} == 0) { - $latest = $release; - last; - } - } - + my $latest = getLatestSuccessfulRelease($project, $primaryJob, $jobs); 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); } diff --git a/src/Hydra/lib/Hydra/Helper/Nix.pm b/src/Hydra/lib/Hydra/Helper/Nix.pm index c7fa8ea7..5a18710c 100644 --- a/src/Hydra/lib/Hydra/Helper/Nix.pm +++ b/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; diff --git a/src/Hydra/script/hydra_update_gc_roots.pl b/src/Hydra/script/hydra_update_gc_roots.pl index 0fd020b3..6796ad33 100755 --- a/src/Hydra/script/hydra_update_gc_roots.pl +++ b/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. @@ -64,9 +66,28 @@ foreach my $project ($db->resultset('Projects')->all) { , order_by => 'timestamp DESC' , rows => 3 # !!! should make this configurable }); - + 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}}; + } + } + }