* Implemented the clone feature.

src/lib/Hydra/Controller/Build.pm

@@ -404,11 +404,13 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
     
     requireProjectOwner($c, $build->project);
 
-    my ($nixExprPath, $nixExprInput) = Hydra::Controller::Jobset::nixExprPathFromParams $c;
+    my ($nixExprPath, $nixExprInputName) = Hydra::Controller::Jobset::nixExprPathFromParams $c;
 
     my $jobName = trim $c->request->params->{"jobname"};
     error($c, "Invalid job name: $jobName") if $jobName !~ /^$jobNameRE$/;
 
+    my $inputInfo = {};
+
     foreach my $param (keys %{$c->request->params}) {
         next unless $param =~ /^input-(\w+)-name$/;
         my $baseName = $1;
@@ -417,14 +419,40 @@ sub clone_submit : Chained('build') PathPart('clone/submit') Args(0) {
         my $inputValue = Hydra::Controller::Jobset::checkInputValue(
             $c, $inputType, $c->request->params->{"input-$baseName-value"});
         eval {
-            fetchInput(
+            # !!! fetchInput can take a long time, which might cause
+            # the current HTTP request to time out.  So maybe this
+            # should be done asynchronously.  But then error reporting
+            # becomes harder.
+            my $info = fetchInput(
                 $c->model('DB'), $build->project, $build->jobset,
                 $inputName, $inputType, $inputValue);
+            push @{$$inputInfo{$inputName}}, $info if defined $info;
         };
         error($c, $@) if $@;
     }
 
-    $c->flash->{buildMsg} = "Build XXX added to the queue.";
+    my ($jobs, $nixExprInput) = evalJobs($inputInfo, $nixExprInputName, $nixExprPath);
+
+    my $job;
+    foreach my $j (@{$jobs->{job}}) {
+        print STDERR $j->{jobName}, "\n";
+        if ($j->{jobName} eq $jobName) {
+            error($c, "Nix expression returned multiple builds for job $jobName.")
+                if $job;
+            $job = $j;
+        }
+    }
+
+    error($c, "Nix expression did not return a job named $jobName.") unless $job;
+
+    my %currentBuilds;
+    my $newBuild = checkBuild(
+        $c->model('DB'), $build->project, $build->jobset,
+        $inputInfo, $nixExprInput, $job, \%currentBuilds);
+
+    error($c, "This build has already been performed.") unless $newBuild;
+    
+    $c->flash->{buildMsg} = "Build " . $newBuild->id . " added to the queue.";
     
     $c->res->redirect($c->uri_for($c->controller('Root')->action_for('queue')));
 }

src/lib/Hydra/Helper/AddBuilds.pm

@@ -1,11 +1,14 @@
 package Hydra::Helper::AddBuilds;
 
 use strict;
+use feature 'switch';
+use XML::Simple;
 use POSIX qw(strftime);
+use IPC::Run;
 use Hydra::Helper::Nix;
 
 our @ISA = qw(Exporter);
-our @EXPORT = qw(fetchInput);
+our @EXPORT = qw(fetchInput evalJobs checkBuild);
 
 
 sub getStorePathHash {
@@ -224,3 +227,162 @@ sub fetchInput {
         die "Input `" . $name . "' has unknown type `$type'.";
     }
 }
+
+
+sub inputsToArgs {
+    my ($inputInfo) = @_;
+    my @res = ();
+
+    foreach my $input (keys %{$inputInfo}) {
+        foreach my $alt (@{$inputInfo->{$input}}) {
+            given ($alt->{type}) {
+                when ("string") {
+                    push @res, "--argstr", $input, $alt->{value};
+                }
+                when ("boolean") {
+                    push @res, "--arg", $input, $alt->{value};
+                }
+                when (["svn", "path", "build"]) {
+                    push @res, "--arg", $input, (
+                        "{ outPath = builtins.storePath " . $alt->{storePath} . "" .
+                        (defined $alt->{revision} ? "; rev = \"" . $alt->{revision} . "\"" : "") .
+                        (defined $alt->{version} ? "; version = \"" . $alt->{version} . "\"" : "") .
+                        ";}"
+                    );
+                }
+            }
+        }
+    }
+
+    return @res;
+}
+
+
+sub captureStdoutStderr {
+    my $stdin = ""; my $stdout; my $stderr;
+    my $res = IPC::Run::run(\@_, \$stdin, \$stdout, \$stderr);
+    return ($res, $stdout, $stderr);
+}
+
+    
+sub evalJobs {
+    my ($inputInfo, $nixExprInputName, $nixExprPath) = @_;
+
+    my $nixExprInput = $inputInfo->{$nixExprInputName}->[0]
+        or die "Cannot find the input containing the job expression.\n";
+    die "Multiple alternatives for the input containing the Nix expression are not supported.\n"
+        if scalar @{$inputInfo->{$nixExprInputName}} != 1;
+    my $nixExprFullPath = $nixExprInput->{storePath} . "/" . $nixExprPath;
+    
+    (my $res, my $jobsXml, my $stderr) = captureStdoutStderr(
+        "hydra_eval_jobs", $nixExprFullPath, "--gc-roots-dir", getGCRootsDir,
+        inputsToArgs($inputInfo));
+    die "Cannot evaluate the Nix expression containing the jobs:\n$stderr" unless $res;
+
+    print STDERR "$stderr";
+
+    my $jobs = XMLin(
+        $jobsXml,
+        ForceArray => ['error', 'job', 'arg'],
+        KeyAttr => [],
+        SuppressEmpty => '')
+        or die "cannot parse XML output";
+
+    return ($jobs, $nixExprInput);
+}
+
+
+# Check whether to add the build described by $buildInfo.
+sub checkBuild {
+    my ($db, $project, $jobset, $inputInfo, $nixExprInput, $buildInfo, $currentBuilds) = @_;
+
+    my $jobName = $buildInfo->{jobName};
+    my $drvPath = $buildInfo->{drvPath};
+    my $outPath = $buildInfo->{outPath};
+
+    my $priority = 100;
+    $priority = int($buildInfo->{schedulingPriority})
+        if $buildInfo->{schedulingPriority} =~ /^\d+$/;
+
+    my $build;
+
+    txn_do($db, sub {
+        # Update the last evaluation time in the database.
+        my $job = $jobset->jobs->update_or_create(
+            { name => $jobName
+            , lastevaltime => time
+            });
+
+        $job->update({firstevaltime => time})
+            unless defined $job->firstevaltime;
+
+        # Don't add a build that has already been scheduled for this
+        # job, or has been built but is still a "current" build for
+        # this job.  Note that this means that if the sources of a job
+        # are changed from A to B and then reverted to A, three builds
+        # will be performed (though the last one will probably use the
+        # cached result from the first).  This ensures that the builds
+        # with the highest ID will always be the ones that we want in
+        # the channels.
+        # !!! Checking $outPath doesn't take meta-attributes into
+        # account.  For instance, do we want a new build to be
+        # scheduled if the meta.maintainers field is changed?
+        my @previousBuilds = $job->builds->search({outPath => $outPath, isCurrent => 1});
+        if (scalar(@previousBuilds) > 0) {
+            print STDERR "already scheduled/built\n";
+            $currentBuilds->{$_->id} = 1 foreach @previousBuilds;
+            return;
+        }
+        
+        # Nope, so add it.
+        $build = $job->builds->create(
+            { finished => 0
+            , timestamp => time()
+            , description => $buildInfo->{description}
+            , longdescription => $buildInfo->{longDescription}
+            , license => $buildInfo->{license}
+            , homepage => $buildInfo->{homepage}
+            , maintainers => $buildInfo->{maintainers}
+            , nixname => $buildInfo->{nixName}
+            , drvpath => $drvPath
+            , outpath => $outPath
+            , system => $buildInfo->{system}
+            , iscurrent => 1
+            , nixexprinput => $jobset->nixexprinput
+            , nixexprpath => $jobset->nixexprpath
+            });
+
+        print STDERR "added to queue as build ", $build->id, "\n";
+        
+        $currentBuilds->{$build->id} = 1;
+        
+        $build->create_related('buildschedulinginfo',
+            { priority => $priority
+            , busy => 0
+            , locker => ""
+            });
+
+        my %inputs;
+        $inputs{$jobset->nixexprinput} = $nixExprInput;
+        foreach my $arg (@{$buildInfo->{arg}}) {
+            $inputs{$arg->{name}} = $inputInfo->{$arg->{name}}->[$arg->{altnr}]
+                || die "invalid input";
+        }
+
+        foreach my $name (keys %inputs) {
+            my $input = $inputs{$name};
+            $build->buildinputs_builds->create(
+                { name => $name
+                , type => $input->{type}
+                , uri => $input->{uri}
+                , revision => $input->{revision}
+                , value => $input->{value}
+                , dependency => $input->{id}
+                , path => $input->{storePath} || "" # !!! temporary hack
+                , sha256hash => $input->{sha256hash}
+                });
+        }
+    });
+
+    return $build;
+};

src/script/hydra_scheduler.pl

@@ -2,11 +2,9 @@
 
 use strict;
 use feature 'switch';
-use XML::Simple;
 use Hydra::Schema;
 use Hydra::Helper::Nix;
 use Hydra::Helper::AddBuilds;
-use IPC::Run;
 
 
 STDOUT->autoflush();
@@ -14,13 +12,6 @@ STDOUT->autoflush();
 my $db = openHydraDB;
 
 
-sub captureStdoutStderr {
-    my $stdin = ""; my $stdout; my $stderr;
-    my $res = IPC::Run::run(\@_, \$stdin, \$stdout, \$stderr);
-    return ($res, $stdout, $stderr);
-}
-
-    
 sub fetchInputs {
     my ($project, $jobset, $inputInfo) = @_;
     foreach my $input ($jobset->jobsetinputs->all) {
@@ -32,98 +23,6 @@ sub fetchInputs {
 }
 
 
-# Check whether to add the build described by $buildInfo.
-sub checkBuild {
-    my ($project, $jobset, $inputInfo, $nixExprInput, $buildInfo, $currentBuilds) = @_;
-
-    my $jobName = $buildInfo->{jobName};
-    my $drvPath = $buildInfo->{drvPath};
-    my $outPath = $buildInfo->{outPath};
-
-    my $priority = 100;
-    $priority = int($buildInfo->{schedulingPriority})
-        if $buildInfo->{schedulingPriority} =~ /^\d+$/;
-
-    txn_do($db, sub {
-        # Update the last evaluation time in the database.
-        my $job = $jobset->jobs->update_or_create(
-            { name => $jobName
-            , lastevaltime => time
-            });
-
-        $job->update({firstevaltime => time})
-            unless defined $job->firstevaltime;
-
-        # Don't add a build that has already been scheduled for this
-        # job, or has been built but is still a "current" build for
-        # this job.  Note that this means that if the sources of a job
-        # are changed from A to B and then reverted to A, three builds
-        # will be performed (though the last one will probably use the
-        # cached result from the first).  This ensures that the builds
-        # with the highest ID will always be the ones that we want in
-        # the channels.
-        # !!! Checking $outPath doesn't take meta-attributes into
-        # account.  For instance, do we want a new build to be
-        # scheduled if the meta.maintainers field is changed?
-        my @previousBuilds = $job->builds->search({outPath => $outPath, isCurrent => 1});
-        if (scalar(@previousBuilds) > 0) {
-            print "already scheduled/built\n";
-            $currentBuilds->{$_->id} = 1 foreach @previousBuilds;
-            return;
-        }
-        
-        # Nope, so add it.
-        my $build = $job->builds->create(
-            { finished => 0
-            , timestamp => time()
-            , description => $buildInfo->{description}
-            , longdescription => $buildInfo->{longDescription}
-            , license => $buildInfo->{license}
-            , homepage => $buildInfo->{homepage}
-            , maintainers => $buildInfo->{maintainers}
-            , nixname => $buildInfo->{nixName}
-            , drvpath => $drvPath
-            , outpath => $outPath
-            , system => $buildInfo->{system}
-            , iscurrent => 1
-            , nixexprinput => $jobset->nixexprinput
-            , nixexprpath => $jobset->nixexprpath
-            });
-
-        print "added to queue as build ", $build->id, "\n";
-        
-        $currentBuilds->{$build->id} = 1;
-        
-        $build->create_related('buildschedulinginfo',
-            { priority => $priority
-            , busy => 0
-            , locker => ""
-            });
-
-        my %inputs;
-        $inputs{$jobset->nixexprinput} = $nixExprInput;
-        foreach my $arg (@{$buildInfo->{arg}}) {
-            $inputs{$arg->{name}} = $inputInfo->{$arg->{name}}->[$arg->{altnr}]
-                || die "invalid input";
-        }
-
-        foreach my $name (keys %inputs) {
-            my $input = $inputs{$name};
-            $build->buildinputs_builds->create(
-                { name => $name
-                , type => $input->{type}
-                , uri => $input->{uri}
-                , revision => $input->{revision}
-                , value => $input->{value}
-                , dependency => $input->{id}
-                , path => $input->{storePath} || "" # !!! temporary hack
-                , sha256hash => $input->{sha256hash}
-                });
-        }
-    });
-};
-
-
 sub setJobsetError {
     my ($jobset, $errorMsg) = @_;
     eval {
@@ -134,35 +33,6 @@ sub setJobsetError {
 }
 
 
-sub inputsToArgs {
-    my ($inputInfo) = @_;
-    my @res = ();
-
-    foreach my $input (keys %{$inputInfo}) {
-        foreach my $alt (@{$inputInfo->{$input}}) {
-            given ($alt->{type}) {
-                when ("string") {
-                    push @res, "--argstr", $input, $alt->{value};
-                }
-                when ("boolean") {
-                    push @res, "--arg", $input, $alt->{value};
-                }
-                when (["svn", "path", "build"]) {
-                    push @res, "--arg", $input, (
-                        "{ outPath = builtins.storePath " . $alt->{storePath} . "" .
-                        (defined $alt->{revision} ? "; rev = \"" . $alt->{revision} . "\"" : "") .
-                        (defined $alt->{version} ? "; version = \"" . $alt->{version} . "\"" : "") .
-                        ";}"
-                    );
-                }
-            }
-        }
-    }
-
-    return @res;
-}
-
-
 sub permute {
     my @list = @_;
     for (my $n = scalar @list - 1; $n > 0; $n--) {
@@ -181,31 +51,14 @@ sub checkJobset {
     fetchInputs($project, $jobset, $inputInfo);
 
     # Evaluate the job expression.
-    my $nixExprInput = $inputInfo->{$jobset->nixexprinput}->[0]
+    my ($jobs, $nixExprInput) = evalJobs($inputInfo, $jobset->nixexprinput, $jobset->nixexprpath);
-        or die "cannot find the input containing the job expression";
-    die "multiple alternatives for the input containing the Nix expression are not supported"
-        if scalar @{$inputInfo->{$jobset->nixexprinput}} != 1;
-    my $nixExprPath = $nixExprInput->{storePath} . "/" . $jobset->nixexprpath;
-
-    (my $res, my $jobsXml, my $stderr) = captureStdoutStderr(
-        "hydra_eval_jobs", $nixExprPath, "--gc-roots-dir", getGCRootsDir,
-        inputsToArgs($inputInfo));
-    die "cannot evaluate the Nix expression containing the jobs:\n$stderr" unless $res;
-
-    print STDERR "$stderr";
-
-    my $jobs = XMLin($jobsXml,
-                     ForceArray => ['error', 'job', 'arg'],
-                     KeyAttr => [],
-                     SuppressEmpty => '')
-        or die "cannot parse XML output";
 
     # Schedule each successfully evaluated job.
     my %currentBuilds;
     foreach my $job (permute @{$jobs->{job}}) {
         next if $job->{jobName} eq "";
         print "considering job " . $job->{jobName} . "\n";
-        checkBuild($project, $jobset, $inputInfo, $nixExprInput, $job, \%currentBuilds);
+        checkBuild($db, $project, $jobset, $inputInfo, $nixExprInput, $job, \%currentBuilds);
     }
 
     txn_do($db, sub {