Add periodical build support.

* src/cuirass/database.scm (db-get-time-since-previous-build): New procedure,
(db-register-builds): if the period argument is set, only register builds
which last registration is older than the specified period.

1 files changed, 20 insertions, 1 deletions

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index fc3eb00..94060b7 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -64,6 +64,7 @@
             db-get-inputs
             db-get-build
             db-get-builds
+            db-get-time-since-previous-build
             db-get-builds-by-search
             db-get-builds-min
             db-get-builds-max
@@ -713,6 +714,7 @@ path) VALUES ("
            (system   (assq-ref job #:system))
            (nix-name (assq-ref job #:nix-name))
            (log      (assq-ref job #:log))
+           (period   (assq-ref job #:period))
            (outputs  (assq-ref job #:outputs))
            (cur-time (time-second (current-time time-utc))))
       (and (new-outputs? outputs)
@@ -731,7 +733,14 @@ path) VALUES ("
                           (#:timestamp . ,cur-time)
                           (#:starttime . 0)
                           (#:stoptime . 0))))
-             (db-add-build build)))))
+             (if period
+                 (let* ((time (db-get-time-since-previous-build job-name))
+                        (add-build? (cond
+                                     ((not time) #t)
+                                     ((> time period) #t)
+                                     (else #f))))
+                   (and add-build? (db-add-build build)))
+                 (db-add-build build))))))
 
   ;; Use the database worker dedicated to write queries.  We don't want this
   ;; query to be queued as it is already a quite large transaction by itself,
@@ -1073,6 +1082,16 @@ ORDER BY ~a;"
     (let ((key (if (number? derivation-or-id) 'id 'derivation)))
       (expect-one-row (db-get-builds `((,key . ,derivation-or-id)))))))
 
+(define (db-get-time-since-previous-build job-name)
+  "Return the time difference in seconds between the current time and the
+registration time of the last build for JOB-NAME."
+  (with-db-worker-thread db
+    (let ((rows (sqlite-exec db "
+SELECT strftime('%s', 'now') - timestamp FROM Builds
+WHERE job_name  = " job-name
+"ORDER BY timestamp DESC LIMIT 1")))
+      (and=> (expect-one-row rows) (cut vector-ref <> 0)))))
+
 (define (db-add-event type timestamp details)
   (when (%record-events?)
     (with-db-writer-worker-thread db