Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -44,11 +44,11 @@ ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) ((register-run) (apply db:register-run db params)) - ((set-tests-state-status) (apply db:set-state-status db params)) + ((set-tests-state-status) (apply db:set-tests-state-status db params)) ((get-tests-for-run) (map vector->list (apply db:get-tests-for-run db params))) ((get-test-id) (apply db:get-test-id-not-cached db params)) ((get-tests-for-runs-mindata) (map vector->list (apply db:get-tests-for-runs-mindata db params))) ((get-run-name-from-id) (apply db:get-run-name-from-id db params)) ((delete-run) (apply db:delete-run db params)) @@ -58,10 +58,12 @@ (list hedr (map vector->list data)))) ((get-runs-by-patt) (let* ((res (apply db:get-runs-by-patt db params)) (hedr (vector-ref res 0)) (data (vector-ref res 1))) (list hedr (map vector->list data)))) + ((lock/unlock-run) (apply db:lock/unlock-run params)) + ((update-run-event_time) (apply db:update-run-event_time params)) ;; MISC ((login) (apply db:login db params)) ((general-call) (let ((stmtname (car params)) (realparams (cdr params))) @@ -81,11 +83,12 @@ (thread-sleep! 3) (if pid (process-signal pid signal/kill) (thread-start! th1)) '(#t "exit process started"))) - + ((testmeta-add-record) (apply db:testmeta-add-record params)) + ((testmeta-update-field) (apply db:testmeta-update-field params)) (else (list "ERROR" 0)))) ;; http-server send-response ;; api:process-request Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -875,11 +875,11 @@ (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'")) (begin (debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey) (exit 6))))) keyvals) - (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time" + (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time " (if limit (conc " LIMIT " limit) "") (if offset (conc " OFFSET " offset) "") ";")) (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt) (sqlite3:for-each-row @@ -926,13 +926,11 @@ (sqlite3:execute stmt2 run-id))) (sqlite3:finalize! stmt1) (sqlite3:finalize! stmt2))) (define (db:update-run-event_time db run-id) - (debug:print-info 11 "db:update-run-event_time START run-id: " run-id) - (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id) - (debug:print-info 11 "db:update-run-event_time END run-id: " run-id)) + (sqlite3:execute db "UPDATE runs SET event_time=strftime('%s','now') WHERE id=?;" run-id)) (define (db:lock/unlock-run db run-id lock unlock user) (let ((newlockval (if lock "locked" (if unlock "unlocked" Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -107,14 +107,10 @@ work-area (rmt:test-get-rundir-from-test-id test-id)))) (debug:print 3 "TEST PATH: " test-path) (open-test-db test-path))) -(define (rmt:testmeta-get-record testname) - (list->vector - (rmt:send-receive 'testmeta-get-record (list testname)))) - ;; WARNING: This currently bypasses the transaction wrapped writes system (define (rmt:test-set-state-status-by-id test-id newstate newstatus newcomment) (rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment))) @@ -210,11 +206,17 @@ (define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit) (let* ((res (rmt:send-receive 'get-runs-by-patt (list runpatt count offset keypatts))) (hedr (car res)) (data (cadr res))) (vector hedr (map list->vector data)))) - + +(define (rmt:lock/unlock-run run-id lock unlock user) + (rmt:send-receive 'lock/unlock-run (list run-id lock unlock user))) + +(define (rmt:update-run-event_time run-id) + (rmt:send-receive 'update-run-event_time (list run-id))) + ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Getting steps is more complicated. @@ -239,5 +241,15 @@ (define (rmt:read-test-data test-id categorypatt #!key (work-area #f)) (let ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area))) (if tdb (tdb:read-test-data tdb test-id categorypatt) '()))) + +(define (rmt:testmeta-add-record testname) + (rmt:send-receive 'testmeta-add-record (list testname))) + +(define (rmt:testmeta-get-record testname) + (list->vector + (rmt:send-receive 'testmeta-get-record (list testname)))) + +(define (rmt:testmeta-update-field test-name fld val) + (rmt:send-receive 'testmeta-update-field (list test-name fld val))) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -1355,11 +1355,11 @@ (take dparts (- (length dparts) 1)) "/")))) (debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname") " and related record") (rmt:delete-run run-id) (rmt:delete-old-deleted-test-records) - (cdb:remote-run db:set-var db "DELETED_TESTS" (current-seconds)) + ;; (cdb:remote-run db:set-var db "DELETED_TESTS" (current-seconds)) ;; need to figure out the path to the run dir and remove it if empty ;; (if (null? (glob (conc runpath "/*"))) ;; (begin ;; (debug:print 1 "Removing run dir " runpath) ;; (system (conc "rmdir -p " runpath)))) @@ -1437,55 +1437,56 @@ (if (or lock (and unlock (begin (print "Do you really wish to unlock run " run-id "?\n y/n: ") (equal? "y" (read-line))))) - (cdb:remote-run db:lock/unlock-run db run-id lock unlock user) + (rmt:lock/unlock-run run-id lock unlock user) (debug:print-info 0 "Skipping lock/unlock on " run-id)))) runs))) ;;====================================================================== ;; Rollup runs ;;====================================================================== ;; Update the test_meta table for this test (define (runs:update-test_meta test-name test-conf) - (let ((currrecord (cdb:remote-run db:testmeta-get-record #f test-name))) + (let ((currrecord (rmt:testmeta-get-record test-name))) (if (not currrecord) (begin (set! currrecord (make-vector 10 #f)) - (cdb:remote-run db:testmeta-add-record #f test-name))) + (rmt:testmeta-add-record test-name))) (for-each (lambda (key) (let* ((idx (cadr key)) (fld (car key)) (val (config-lookup test-conf "test_meta" fld))) ;; (debug:print 5 "idx: " idx " fld: " fld " val: " val) (if (and val (not (equal? (vector-ref currrecord idx) val))) (begin (print "Updating " test-name " " fld " to " val) - (cdb:remote-run db:testmeta-update-field #f test-name fld val))))) + (rmt:testmeta-update-field test-name fld val))))) '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9))))) ;; Update test_meta for all tests (define (runs:update-all-test_meta db) (let ((test-names (tests:get-all))) ;; (tests:get-valid-tests))) (for-each (lambda (test-name) (let* ((test-conf (mt:lazy-read-test-config test-name))) - ;; use the cdb:remote-run instead of passing in db (if test-conf (runs:update-test_meta test-name test-conf)))) (hash-table-keys test-names)))) ;; This could probably be refactored into one complex query ... +;; NOT PORTED - DO NOT USE YET +;; (define (runs:rollup-run keys runname user keyvals) (debug:print 4 "runs:rollup-run, keys: " keys " :runname " runname " user: " user) (let* ((db #f) - (new-run-id (cdb:remote-run db:register-run #f keyvals runname "new" "n/a" user)) - (prev-tests (cdb:remote-run test:get-matching-previous-test-run-records db new-run-id "%" "%")) + (new-run-id (rmt:register-run keyvals runname "new" "n/a" user)) + (prev-tests (rmt:get-matching-previous-test-run-records new-run-id "%" "%")) (curr-tests (mt:get-tests-for-run new-run-id "%/%" '() '())) (curr-tests-hash (make-hash-table))) - (cdb:remote-run db:update-run-event_time db new-run-id) + (rmt:update-run-event_time new-run-id) ;; index the already saved tests by testname and itemdat in curr-tests-hash (for-each (lambda (testdat) (let* ((testname (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) @@ -1499,11 +1500,11 @@ (lambda (testdat) (let* ((testname (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) (full-name (conc testname "/" item-path)) (prev-test-dat (hash-table-ref/default curr-tests-hash full-name #f)) - (test-steps (cdb:remote-run db:get-steps-for-test db (db:test-get-id testdat))) + (test-steps (rmt:get-steps-for-test (db:test-get-id testdat))) (new-test-record #f)) ;; replace these with insert ... select (apply sqlite3:execute db (conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) "