@@ -28,11 +28,136 @@ (declare (uses tcp-transportmod)) (declare (uses apimod)) (declare (uses servermod)) (module rmtmod - * + ( + rmt:get-tests-for-run-state-status + rmt:tasks-get-last + rmt:read-test-data + rmt:get-targets + rmt:get-run-stats + rmt:get-key-vals + rmt:test-data-rollup + rmt:import-sexpr + rmt:read-test-data-varpatt + rmt:get-run-status + rmt:set-run-status + + rmtmod:send-receive + rmt:send-receive + rmt:no-sync-get-lock + rmt:no-sync-del! + rmt:no-sync-set + rmt:no-sync-get/default + + rmt:get-runs-by-patt + rmt:get-testinfo-state-status + rmt:get-test-id + rmt:set-state-status-and-roll-up-items + + rmt:get-prereqs-not-met + rmt:get-tests-for-run + + rmt:get-keys + rmt:test-get-records-for-index-file + tests:test-set-toplog! + rmt:test-get-logfile-info + rmt:general-call + rmt:test-get-paths-matching-keynames-target-new + rmt:get-test-info-by-id + rmt:get-steps-for-test + rmt:get-num-runs + rmt:get-runs-cnt-by-patt + rmt:get-runs + + rmt:get-latest-host-load + rmt:get-changed-record-test-ids + rmt:get-all-runids + rmt:get-changed-record-run-ids + rmt:get-run-record-ids + rmt:get-data-info-by-id + rmt:get-steps-info-by-id + rmt:get-target + + rmt:get-run-name-from-id + rmt:get-run-info + rmt:get-test-times + rmt:get-run-times + + rmt:tasks-find-task-queue-records + + common:api-changed? + rmt:on-homehost? + + rmt:get-var + rmt:csv->test-data + rmt:get-previous-test-run-record + + common:cleanup-db + common:get-last-run-version + + rmt:get-key-val-pairs + rmt:create-all-triggers + rmt:update-tesdata-on-repilcate-db + rmt:drop-all-triggers + rmt:test-get-archive-block-info + rmt:test-toplevel-num-items + rmt:archive-get-allocations + rmt:archive-register-disk + rmt:archive-register-block-name + + mt:get-runs-by-patt + rmt:simple-get-runs + rmt:get-tests-for-runs-mindata + rmt:test-get-top-process-pid + rmt:set-state-status-and-roll-up-run + rmt:get-run-state-status + rmt:get-not-completed-cnt + rmt:get-tests-tags + rmt:testmeta-update-field + rmt:testmeta-add-record + rmt:testmeta-get-record + rmt:lock/unlock-run + rmt:delete-old-deleted-test-records + rmt:delete-run + rmt:get-raw-run-stats + rmt:update-run-stats + rmt:delete-test-records + rmt:test-set-archive-block-id + mt:get-tests-for-run + mt:test-set-state-status-by-testname + mt:test-set-state-status-by-testname-unless-completed + rmt:register-test + mt:test-set-state-status-by-id-unless-completed + rmt:get-all-run-ids + + rmt:set-run-state-status + rmt:set-var + rmt:set-tests-state-status + rmt:tasks-add + rmt:tasks-set-state-given-param-key + rmt:register-run + rmt:get-count-tests-running-in-jobgroup + rmt:get-count-tests-running-for-run-id + + rmt:test-set-state-status-by-id + mt:test-set-state-status-by-id + + rmt:get-status-from-final-status-file + rmt:get-toplevels-and-incompletes + + rmt:test-set-log! + rmt:teststep-set-status! + + rmt:delete-steps-for-test! + rmt:test-set-state-status + rmt:get-test-state-status-by-id + rmt:test-set-top-process-pid + + ) + (import scheme chicken data-structures regex @@ -164,18 +289,10 @@ (rmtmod:send-receive 'get-test-state-status-by-id run-id (list run-id test-id))) (define (rmt:test-get-rundir-from-test-id run-id test-id) (rmtmod:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id))) -;; (define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f)) -;; (assert (number? run-id) "FATAL: Run id required.") -;; (let* ((test-path (if (string? work-area) -;; work-area -;; (rmt:test-get-rundir-from-test-id run-id test-id)))) -;; (debug:print 3 *default-log-port* "TEST PATH: " test-path) -;; (open-test-db test-path))) - ;; WARNING: This currently bypasses the transaction wrapped writes system (define (rmt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment) (assert (number? run-id) "FATAL: Run id required.") (rmtmod:send-receive 'test-set-state-status-by-id run-id (list run-id test-id newstate newstatus newcomment))) @@ -705,14 +822,14 @@ (rmt:send-receive 'update-run-event_time #f (list run-id))) (define (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit fields last-runs-update #!key (sort-order "asc")) ;; fields of #f uses default (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update sort-order))) -(define (rmt:find-and-mark-incomplete run-id ovr-deadtime) - (assert (number? run-id) "FATAL: Run id required.") - ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime)) - (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; ) +;; (define (rmt:find-and-mark-incomplete run-id ovr-deadtime) +;; (assert (number? run-id) "FATAL: Run id required.") +;; ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime)) +;; (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; ) (define (rmt:get-main-run-stats run-id) (assert (number? run-id) "FATAL: Run id required.") (rmt:send-receive 'get-main-run-stats #f (list run-id))) @@ -737,15 +854,15 @@ ;;====================================================================== ;; M U L T I R U N Q U E R I E S ;;====================================================================== ;; Need to move this to multi-run section and make associated changes -(define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f)) - (let ((run-ids (rmt:get-all-run-ids))) - (for-each (lambda (run-id) - (rmt:find-and-mark-incomplete run-id ovr-deadtime)) - run-ids))) +;; (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f)) +;; (let ((run-ids (rmt:get-all-run-ids))) +;; (for-each (lambda (run-id) +;; (rmt:find-and-mark-incomplete run-id ovr-deadtime)) +;; run-ids))) ;; get the previous record for when this test was run where all keys match but runname ;; returns #f if no such test found, returns a single test record if found ;; ;; Run this at the client end since we have to connect to multiple run-id dbs @@ -950,11 +1067,10 @@ #f))) #f))) ;; not true strickly speaking, might be runremote was not yet initialized. (define (make-and-init-remote areapath) (case (rmt:transport-mode) - ((http)(make-remote)) ((tcp) (tt:make-remote areapath)) (else #f))) ;; how to make area-dat (define (rmt:set-ttdat areapath ttdat)