* In job inputs of type "build", allow the project and jobset names of

the input build to be specified, as well as constraints on the
  inputs of the inputs build.  For instance, you can require that a
  build has input `system = "i686-linux"'.

  This is important when one binary build serves as an input to
  another binary build.  Obviously, we shouldn't pass a build on
  i686-linux as an input to another on i686-darwin.  Hence the
  necessity for constraint.

  The constraint are currently quite limited.  What you really want to
  say is that the "system" input of the other build has to match the
  "system" input of this build.  But those require a bit more work
  since they introduce dependencies between inputs.
This commit is contained in:
Eelco Dolstra 2009-03-20 14:50:09 +00:00
parent d1affbfe1a
commit 2755c895ff
2 changed files with 75 additions and 23 deletions

View file

@ -118,7 +118,7 @@ sub attrsToSQL {
# 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";
$query .= " and exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";
}
return $query;

View file

@ -33,6 +33,45 @@ sub getStorePathHash {
}
sub parseJobName {
# Parse a job specification of the form `<project>:<jobset>:<job>
# [attrs]'. The project, jobset and attrs may be omitted. The
# attrs have the form `name = "value"'.
my ($s) = @_;
our $key;
our %attrs = ();
# hm, maybe I should stop programming Perl before it's too late...
$s =~ / ^ (?: (?: ([\w\-]+) : )? ([\w\-]+) : )? ([\w\-]+) \s*
(\[ \s* (
([\w]+) (?{ $key = $^N; }) \s* = \s* \"
([\w\-]+) (?{ $attrs{$key} = $^N; }) \"
\s* )* \])? $
/x
or die "invalid job specifier `$s'";
return ($1, $2, $3, \%attrs);
}
sub attrsToSQL {
my ($attrs, $id) = @_;
my $query = "1 = 1";
foreach my $name (keys %{$attrs}) {
my $value = $attrs->{$name};
$name =~ /^[\w\-]+$/ or die;
$value =~ /^[\w\-]+$/ or die;
# !!! 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 exists (select 1 from buildinputs where build = $id and name = '$name' and value = '$value')";
}
return $query;
}
sub fetchInputAlt {
my ($project, $jobset, $input, $alt) = @_;
my $type = $input->type;
@ -151,18 +190,24 @@ sub fetchInputAlt {
}
elsif ($type eq "build") {
my $jobName = $alt->value or die;
my ($projectName, $jobsetName, $jobName, $attrs) = parseJobName($alt->value);
$projectName ||= $project->name;
$jobsetName ||= $jobset->name;
# Pick the most recent successful build of the specified job.
(my $prevBuild) = $db->resultset('Builds')->search(
{finished => 1, project => $project->name, jobset => $jobset->name, job => $jobName, buildStatus => 0},
{join => 'resultInfo', order_by => "me.id DESC", rows => 1});
{ finished => 1, project => $projectName, jobset => $jobsetName
, job => $jobName, buildStatus => 0 },
{ join => 'resultInfo', order_by => "me.id DESC", rows => 1
, where => \ attrsToSQL($attrs, "me.id") });
if (!defined $prevBuild || !isValidPath($prevBuild->outpath)) {
print STDERR "no previous build available for `$jobName'";
print STDERR "input `", $input->name, "': no previous build available\n";
return undef;
}
#print STDERR "input `", $input->name, "': using build ", $prevBuild->id, "\n";
my $pkgNameRE = "(?:(?:[A-Za-z0-9]|(?:-[^0-9]))+)";
my $versionRE = "(?:[A-Za-z0-9\.\-]+)";
@ -310,14 +355,10 @@ sub inputsToArgs {
}
sub checkJobSet {
sub checkJobset {
my ($project, $jobset) = @_;
my $inputInfo = {};
$db->txn_do(sub {
$jobset->update({lastcheckedtime => time});
});
# Fetch all values for all inputs.
fetchInputs($project, $jobset, $inputInfo);
@ -354,6 +395,8 @@ sub checkJobSet {
push @{$failedJobNames{$_->{location}}}, $_->{msg} foreach @{$jobs->{error}};
$db->txn_do(sub {
$jobset->update({lastcheckedtime => time});
foreach my $jobInDB ($jobset->jobs->all) {
$jobInDB->update({active => $jobNames{$jobInDB->name} || $failedJobNames{$jobInDB->name} ? 1 : 0});
@ -374,22 +417,31 @@ sub checkJobSet {
}
sub checkJobs {
sub checkJobsetWrapped {
my ($project, $jobset) = @_;
print "considering jobset ", $jobset->name, " in ", $project->name, "\n";
eval {
checkJobset($project, $jobset);
};
if ($@) {
my $msg = $@;
print "error evaluating jobset ", $jobset->name, ": $msg";
$db->txn_do(sub {
$jobset->update({lastcheckedtime => time});
setJobsetError($jobset, $msg);
});
}
}
sub checkJobs {
foreach my $project ($db->resultset('Projects')->search({enabled => 1})) {
print "considering project ", $project->name, "\n";
foreach my $jobset ($project->jobsets->all) {
print "considering jobset ", $jobset->name, " in ", $project->name, "\n";
eval {
checkJobSet($project, $jobset);
};
if ($@) {
print "error evaluating jobset ", $jobset->name, ": $@";
setJobsetError($jobset, $@);
}
}
checkJobsetWrapped($project, $_) foreach $project->jobsets->all;
}
}
@ -398,7 +450,7 @@ if (scalar @ARGV == 2) {
my $projectName = $ARGV[0];
my $jobsetName = $ARGV[1];
my $jobset = $db->resultset('Jobsets')->find($projectName, $jobsetName) or die;
checkJobSet($jobset->project, $jobset);
checkJobsetWrapped($jobset->project, $jobset);
exit 0;
}