Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -282,11 +282,11 @@ (let ((astr (vector-ref a 1)) (bstr (vector-ref b 1))) (if (string=? astr "") #f #t))))) ;; (>= (string-length (vector-ref a 1))(string-length (vector-ref b 1)))))) (vlst-s2 (sort vlst-s1 (lambda (a b) - (string>= (vector-ref a 0)(vector-ref b 0)))))) + (string>= (vector-ref a 0)(vector-ref b 0)))))) (map (lambda (x) (if (equal? (vector-ref x 1) "") (vector-ref x 0) (conc (vector-ref x 0) "(" (vector-ref x 1) ")"))) vlst-s2))) Index: task_records.scm ================================================================== --- task_records.scm +++ task_records.scm @@ -7,22 +7,23 @@ ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== -;; make-vector-record tasks task id action owner state target name test item creation_time execution_time -(define (make-tasks:task)(make-vector 10)) +;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time +(define (make-tasks:task)(make-vector 11)) (define-inline (tasks:task-get-id vec) (vector-ref vec 0)) (define-inline (tasks:task-get-action vec) (vector-ref vec 1)) (define-inline (tasks:task-get-owner vec) (vector-ref vec 2)) (define-inline (tasks:task-get-state vec) (vector-ref vec 3)) (define-inline (tasks:task-get-target vec) (vector-ref vec 4)) (define-inline (tasks:task-get-name vec) (vector-ref vec 5)) (define-inline (tasks:task-get-test vec) (vector-ref vec 6)) (define-inline (tasks:task-get-item vec) (vector-ref vec 7)) -(define-inline (tasks:task-get-creation_time vec) (vector-ref vec 8)) -(define-inline (tasks:task-get-execution_time vec) (vector-ref vec 9)) +(define-inline (tasks:task-get-params vec) (vector-ref vec 8)) +(define-inline (tasks:task-get-creation_time vec) (vector-ref vec 9)) +(define-inline (tasks:task-get-execution_time vec) (vector-ref vec 10)) (define-inline (tasks:task-set-state! vec val)(vector-set! vec 3 val)) ;; make-vector-record tasks monitor id pid start_time last_update hostname username Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -37,10 +37,11 @@ target TEXT DEFAULT '', name TEXT DEFAULT '', test TEXT DEFAULT '', item TEXT DEFAULT '', keylock TEXT, + params TEXT, creation_time TIMESTAMP, execution_time TIMESTAMP);") (sqlite3:execute tdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY, pid INTEGER, start_time TIMESTAMP, @@ -84,19 +85,20 @@ "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;" (car (user-information (current-user-id)))) res)) ;; register a task -(define (tasks:add tdb action owner target runname test item) - (sqlite3:execute tdb "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,creation_time,execution_time) +(define (tasks:add tdb action owner target runname test item params) + (sqlite3:execute tdb "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,params,creation_time,execution_time) VALUES (?,?,'new',?,?,?,?,strftime('%s','now'),0);" action owner target runname test - item)) + item + (if params params ""))) (define (keys:key-vals-hash->target keys key-params) (let ((tmp (hash-table-ref/default key-params (vector-ref (car keys) 0) ""))) (if (> (length keys) 1) (for-each (lambda (key) @@ -131,11 +133,11 @@ (sqlite3:for-each-row (lambda (id . rem) (set! res (apply vector id rem))) tdb - "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time FROM tasks_queue WHERE keylock=? ORDER BY execution_time ASC LIMIT 1;" keytxt) + "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time FROM tasks_queue WHERE keylock=? ORDER BY execution_time ASC LIMIT 1;" keytxt) (if res ;; yep, have work to be done (begin (sqlite3:execute tdb "UPDATE tasks_queue SET state='inprogress',execution_time=strftime('%s','now') WHERE id=?;" (tasks:task-get-id res)) res) @@ -158,11 +160,11 @@ (let ((res '())) (sqlite3:for-each-row (lambda (id . rem) (set! res (cons (apply vector id rem) res))) tdb - (conc "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time + (conc "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time FROM tasks_queue " ;; WHERE ;; state IN " statesstr " AND ;; action IN " actionsstr " ORDER BY creation_time DESC;")) @@ -217,12 +219,12 @@ "SELECT id,pid,strftime('%m/%d/%Y %H:%M',datetime(start_time,'unixepoch'),'localtime'),strftime('%m/%d/%Y %H:%M:%S',datetime(last_update,'unixepoch'),'localtime'),hostname,username FROM monitors ORDER BY last_update ASC;") (reverse res) )) (define (tasks:tasks->text tasks) - (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a")) - (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts") "\n" + (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a~10a")) + (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts" "params") "\n" (string-intersperse (map (lambda (task) (format #f fmtstr (tasks:task-get-id task) (tasks:task-get-action task) @@ -229,11 +231,12 @@ (tasks:task-get-owner task) (tasks:task-get-state task) (tasks:task-get-target task) (tasks:task-get-name task) (tasks:task-get-test task) - (tasks:task-get-item task))) + (tasks:task-get-item task) + (tasks:task-get-params task))) tasks) "\n")))) (define (tasks:monitors->text-table monitors) (let ((fmtstr "~4a~8a~20a~20a~10a~10a")) (conc (format #f fmtstr "id" "pid" "start time" "last update" "hostname" "user") "\n" @@ -283,10 +286,12 @@ ;; that no task gets run in parallel. (define (tasks:start-run db tdb task) (let ((flags (make-hash-table))) (hash-table-set! flags "-rerun" "NOT_STARTED") + (if (not (string=? (tasks:task-get-params task) "")) + (hash-table-set! flags "- (print "Starting run " task) ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY (runs:run-tests db (tasks:task-get-target task) (tasks:task-get-name task)