Megatest

rmt.scm at [b28d552c97]
Login

File rmt.scm artifact 3585e1244b part of check-in b28d552c97


;;======================================================================
;; Copyright 2006-2017, Matthew Welland.
;; 
;; This file is part of Megatest.
;; 
;;     Megatest is free software: you can redistribute it and/or modify
;;     it under the terms of the GNU General Public License as published by
;;     the Free Software Foundation, either version 3 of the License, or
;;     (at your option) any later version.
;; 
;;     Megatest is distributed in the hope that it will be useful,
;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;
;;======================================================================

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(import api)

(include "common_records.scm")

(use (prefix pkts pkts:) srfi-18)

(defstruct cmdrec
  cmd
  (host    #f)
  (run-ids #f)
  params)

;; call cmd on remote host (#f for any host)
;;
;; example: (rmt:run 'get-runs target run-name test-patt state status)
;;
(define (rmt:run cmd . params)
  (let ((server (rmt:get-server cmdrec))) ;; look up server 
    #f))
  
(define (rmt:get-connection-info . args)
  #t
  (print "Got here: rmt:get-connection-info"))
(define (rmt:send-receive . args)
  #t
  (print "Got here: rmt:send-receive"))
(define (rmt:print-db-stats . args)
  #t
  (print "Got here: rmt:print-db-stats"))
(define (rmt:get-max-query-average . args)
  #t
  (print "Got here: rmt:get-max-query-average"))
(define (rmt:open-qry-close-locally . args)
  #t
  (print "Got here: rmt:open-qry-close-locally"))
(define (rmt:send-receive-no-auto-client-setup . args)
  #t
  (print "Got here: rmt:send-receive-no-auto-client-setup"))
(define (rmt:kill-server . args)
  #t
  (print "Got here: rmt:kill-server"))
(define (rmt:start-server . args)
  #t
  (print "Got here: rmt:start-server"))
(define (rmt:login . args)
  #t
  (print "Got here: rmt:login"))
(define (rmt:login-no-auto-client-setup . args)
  #t
  (print "Got here: rmt:login-no-auto-client-setup"))
(define (rmt:general-call . args)
  #t
  (print "Got here: rmt:general-call"))
(define (rmt:get-latest-host-load . args)
  #t
  (print "Got here: rmt:get-latest-host-load"))
(define (rmt:sdb-qry . args)
  #t
  (print "Got here: rmt:sdb-qry"))
(define (rmt:runtests . args)
  #t
  (print "Got here: rmt:runtests"))
(define (rmt:get-run-record-ids . args)
  #t
  (print "Got here: rmt:get-run-record-ids"))
(define (rmt:get-changed-record-ids . args)
  #t
  (print "Got here: rmt:get-changed-record-ids"))
(define (rmt:get-tests-tags . args)
  #t
  (print "Got here: rmt:get-tests-tags"))
(define (rmt:get-key-val-pairs . args)
  #t
  (print "Got here: rmt:get-key-val-pairs"))
(define (rmt:get-keys . args)
  #t
  (print "Got here: rmt:get-keys"))
(define (rmt:get-keys-write . args)
  #t
  (print "Got here: rmt:get-keys-write"))
(define (rmt:get-key-vals . args)
  #t
  (print "Got here: rmt:get-key-vals"))
(define (rmt:get-targets . args)
  #t
  (print "Got here: rmt:get-targets"))
(define (rmt:get-target . args)
  #t
  (print "Got here: rmt:get-target"))
(define (rmt:get-run-times . args)
  #t
  (print "Got here: rmt:get-run-times"))
(define (rmt:register-test . args)
  #t
  (print "Got here: rmt:register-test"))
(define (rmt:get-test-id . args)
  #t
  (print "Got here: rmt:get-test-id"))
(define (rmt:get-test-info-by-id . args)
  #t
  (print "Got here: rmt:get-test-info-by-id"))
(define (rmt:test-get-rundir-from-test-id . args)
  #t
  (print "Got here: rmt:test-get-rundir-from-test-id"))
(define (rmt:open-test-db-by-test-id . args)
  #t
  (print "Got here: rmt:open-test-db-by-test-id"))
(define (rmt:test-set-state-status-by-id . args)
  #t
  (print "Got here: rmt:test-set-state-status-by-id"))
(define (rmt:set-tests-state-status . args)
  #t
  (print "Got here: rmt:set-tests-state-status"))
(define (rmt:get-tests-for-run . args)
  #t
  (print "Got here: rmt:get-tests-for-run"))
(define (rmt:synchash-get . args)
  #t
  (print "Got here: rmt:synchash-get"))
(define (rmt:get-tests-for-run-mindata . args)
  #t
  (print "Got here: rmt:get-tests-for-run-mindata"))
(define (rmt:get-tests-for-runs-mindata . args)
  #t
  (print "Got here: rmt:get-tests-for-runs-mindata"))
(define (rmt:delete-test-records . args)
  #t
  (print "Got here: rmt:delete-test-records"))
(define (rmt:test-set-state-status . args)
  #t
  (print "Got here: rmt:test-set-state-status"))
(define (rmt:test-toplevel-num-items . args)
  #t
  (print "Got here: rmt:test-toplevel-num-items"))
(define (rmt:get-matching-previous-test-run-records . args)
  #t
  (print "Got here: rmt:get-matching-previous-test-run-records"))
(define (rmt:test-get-logfile-info . args)
  #t
  (print "Got here: rmt:test-get-logfile-info"))
(define (rmt:test-get-records-for-index-file . args)
  #t
  (print "Got here: rmt:test-get-records-for-index-file"))
(define (rmt:get-testinfo-state-status . args)
  #t
  (print "Got here: rmt:get-testinfo-state-status"))
(define (rmt:test-set-log! . args)
  #t
  (print "Got here: rmt:test-set-log!"))
(define (rmt:test-set-top-process-pid . args)
  #t
  (print "Got here: rmt:test-set-top-process-pid"))
(define (rmt:test-get-top-process-pid . args)
  #t
  (print "Got here: rmt:test-get-top-process-pid"))
(define (rmt:get-run-ids-matching-target . args)
  #t
  (print "Got here: rmt:get-run-ids-matching-target"))
(define (rmt:test-get-paths-matching-keynames-target-new . args)
  #t
  (print "Got here: rmt:test-get-paths-matching-keynames-target-new"))
(define (rmt:get-prereqs-not-met . args)
  #t
  (print "Got here: rmt:get-prereqs-not-met"))
(define (rmt:get-count-tests-running-for-run-id . args)
  #t
  (print "Got here: rmt:get-count-tests-running-for-run-id"))
(define (rmt:get-count-tests-running . args)
  #t
  (print "Got here: rmt:get-count-tests-running"))
(define (rmt:get-count-tests-running-for-testname . args)
  #t
  (print "Got here: rmt:get-count-tests-running-for-testname"))
(define (rmt:get-count-tests-running-in-jobgroup . args)
  #t
  (print "Got here: rmt:get-count-tests-running-in-jobgroup"))
(define (rmt:set-state-status-and-roll-up-items . args)
  #t
  (print "Got here: rmt:set-state-status-and-roll-up-items"))
(define (rmt:update-pass-fail-counts . args)
  #t
  (print "Got here: rmt:update-pass-fail-counts"))
(define (rmt:top-test-set-per-pf-counts . args)
  #t
  (print "Got here: rmt:top-test-set-per-pf-counts"))
(define (rmt:get-raw-run-stats . args)
  #t
  (print "Got here: rmt:get-raw-run-stats"))
(define (rmt:get-test-times . args)
  #t
  (print "Got here: rmt:get-test-times"))
(define (rmt:get-run-info . args)
  #t
  (print "Got here: rmt:get-run-info"))
(define (rmt:get-num-runs . args)
  #t
  (print "Got here: rmt:get-num-runs"))
(define (rmt:get-runs-cnt-by-patt . args)
  #t
  (print "Got here: rmt:get-runs-cnt-by-patt"))
(define (rmt:register-run . args)
  #t
  (print "Got here: rmt:register-run"))
(define (rmt:get-run-name-from-id . args)
  #t
  (print "Got here: rmt:get-run-name-from-id"))
(define (rmt:delete-run . args)
  #t
  (print "Got here: rmt:delete-run"))
(define (rmt:update-run-stats . args)
  #t
  (print "Got here: rmt:update-run-stats"))
(define (rmt:delete-old-deleted-test-records . args)
  #t
  (print "Got here: rmt:delete-old-deleted-test-records"))
(define (rmt:get-runs . args)
  #t
  (print "Got here: rmt:get-runs"))
(define (rmt:simple-get-runs . args)
  #t
  (print "Got here: rmt:simple-get-runs"))
(define (rmt:get-all-run-ids . args)
  #t
  (print "Got here: rmt:get-all-run-ids"))
(define (rmt:get-prev-run-ids . args)
  #t
  (print "Got here: rmt:get-prev-run-ids"))
(define (rmt:lock/unlock-run . args)
  #t
  (print "Got here: rmt:lock/unlock-run"))
(define (rmt:get-run-status . args)
  #t
  (print "Got here: rmt:get-run-status"))
(define (rmt:set-run-status . args)
  #t
  (print "Got here: rmt:set-run-status"))
(define (rmt:update-run-event_time . args)
  #t
  (print "Got here: rmt:update-run-event_time"))
(define (rmt:get-runs-by-patt . args)
  #t
  (print "Got here: rmt:get-runs-by-patt"))
(define (rmt:find-and-mark-incomplete . args)
  #t
  (print "Got here: rmt:find-and-mark-incomplete"))
(define (rmt:get-main-run-stats . args)
  #t
  (print "Got here: rmt:get-main-run-stats"))
(define (rmt:get-var . args)
  #t
  (print "Got here: rmt:get-var"))
(define (rmt:del-var . args)
  #t
  (print "Got here: rmt:del-var"))
(define (rmt:set-var . args)
  #t
  (print "Got here: rmt:set-var"))
(define (rmt:find-and-mark-incomplete-all-runs . args)
  #t
  (print "Got here: rmt:find-and-mark-incomplete-all-runs"))
(define (rmt:get-previous-test-run-record . args)
  #t
  (print "Got here: rmt:get-previous-test-run-record"))
(define (rmt:get-run-stats . args)
  #t
  (print "Got here: rmt:get-run-stats"))
(define (rmt:teststep-set-status! . args)
  #t
  (print "Got here: rmt:teststep-set-status!"))
(define (rmt:get-steps-for-test . args)
  #t
  (print "Got here: rmt:get-steps-for-test"))
(define (rmt:get-steps-info-by-id . args)
  #t
  (print "Got here: rmt:get-steps-info-by-id"))
(define (rmt:read-test-data . args)
  #t
  (print "Got here: rmt:read-test-data"))
(define (rmt:read-test-data* . args)
  #t
  (print "Got here: rmt:read-test-data*"))
(define (rmt:get-data-info-by-id . args)
  #t
  (print "Got here: rmt:get-data-info-by-id"))
(define (rmt:testmeta-add-record . args)
  #t
  (print "Got here: rmt:testmeta-add-record"))
(define (rmt:testmeta-get-record . args)
  #t
  (print "Got here: rmt:testmeta-get-record"))
(define (rmt:testmeta-update-field . args)
  #t
  (print "Got here: rmt:testmeta-update-field"))
(define (rmt:test-data-rollup . args)
  #t
  (print "Got here: rmt:test-data-rollup"))
(define (rmt:csv->test-data . args)
  #t
  (print "Got here: rmt:csv->test-data"))
(define (rmt:tasks-find-task-queue-records . args)
  #t
  (print "Got here: rmt:tasks-find-task-queue-records"))
(define (rmt:tasks-add . args)
  #t
  (print "Got here: rmt:tasks-add"))
(define (rmt:tasks-set-state-given-param-key . args)
  #t
  (print "Got here: rmt:tasks-set-state-given-param-key"))
(define (rmt:tasks-get-last . args)
  #t
  (print "Got here: rmt:tasks-get-last"))
(define (rmt:no-sync-set . args)
  #t
  (print "Got here: rmt:no-sync-set"))
(define (rmt:no-sync-get/default . args)
  #t
  (print "Got here: rmt:no-sync-get/default"))
(define (rmt:no-sync-del! . args)
  #t
  (print "Got here: rmt:no-sync-del!"))
(define (rmt:no-sync-get-lock . args)
  #t
  (print "Got here: rmt:no-sync-get-lock"))
(define (rmt:archive-get-allocations . args)
  #t
  (print "Got here: rmt:archive-get-allocations"))
(define (rmt:archive-register-block-name . args)
  #t
  (print "Got here: rmt:archive-register-block-name"))
(define (rmt:archive-allocate-testsuite/area-to-block . args)
  #t
  (print "Got here: rmt:archive-allocate-testsuite/area-to-block"))
(define (rmt:archive-register-disk . args)
  #t
  (print "Got here: rmt:archive-register-disk"))
(define (rmt:test-set-archive-block-id . args)
  #t
  (print "Got here: rmt:test-set-archive-block-id"))
(define (rmt:test-get-archive-block-info . args)
  #t
  (print "Got here: rmt:test-get-archive-block-info"))