Megatest

(declare (uses dbmod))
(declare (uses mtmod))
(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
	extras
	matchable

(define (rmt:get-test-state-status-by-id run-id test-id)
  (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)))









;; 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)))

(define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus)
  (assert (number? run-id) "FATAL: Run id required.")

(define (rmt:update-run-event_time run-id)
  (assert (number? run-id) "FATAL: Run id required.")
  (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: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)))

(define (rmt:get-var varname)
  (rmt:send-receive 'get-var #f (list varname)))

  (rmt:send-receive 'add-var #f (list varname value)))

;;======================================================================
;; 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)))

;; 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
;;
(define (rmt:get-previous-test-run-record run-id test-name item-path)

	      (begin
		(debug:print-info 0 *default-log-port* "hh-dat="hh-dat)
		#f)))
	#f))) ;; not true strickly speaking, might be runremote was not yet initialized.

(define (make-and-init-remote areapath)
   (case (rmt:transport-mode)

     ((tcp) (tt:make-remote areapath))
     (else #f)))

;; how to make area-dat
(define (rmt:set-ttdat areapath ttdat)
  (if ttdat
    ttdat