Megatest

;; called a lot, maybe from rollup?
db:get-all-state-status-counts-for-test

;; load to move from server to client
tests:summarize-items ;; appears to be on client
tests:summarize-tests

;; converting rmt:set-tests-state-status

1. db:get-test-id needs rmt equiv
2. 

    ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
    ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
    ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) 
    ((top-test-set-per-pf-counts)       (apply db:top-test-set-per-pf-counts dbstruct params))
    ((test-set-archive-block-id)        (apply db:test-set-archive-block-id dbstruct params))

    ((insert-test)                      (db:insert-test dbstruct run-id params))
    ((set-state-status-by-state-status) (apply db:set-state-status-by-state-status dbstruct params))
    
    ;; RUNS
    ((register-run)                 (apply db:register-run dbstruct params))
    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
    ((delete-run)                   (apply db:delete-run dbstruct params))
    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))
    ((update-run-stats)             (apply db:update-run-stats dbstruct params))

       (sqlite3:with-transaction
	db
	(lambda ()
	  (sqlite3:execute db "DELETE FROM test_steps WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime)
	  (sqlite3:execute db "DELETE FROM test_data WHERE test_id IN (SELECT id FROM tests WHERE state='DELETED' AND event_time<?);" targtime)
	  (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED' AND event_time<?;" targtime)))))))




































;; ;; speed up for common cases with a little logic
;; ;; NB// Ultimately this will be deprecated in deference to mt:test-set-state-status-by-id
;;
;;      NOTE: run-id is not used
;; ;;
(define (db:test-set-state-status dbstruct run-id test-id newstate newstatus newcomment)
  (db:with-db

		(begin
		  (debug:print-info 0 *default-log-port* "Found old test in LAUNCHED state, test-id=" test-id
				    " 1 day since event_time marked")
                  (set! oldlaunched (cons (list test-id run-dir uname testname item-path run-id) oldlaunched)))))
	  stmth3
	  run-id))))
    (list incompleted oldlaunched toplevels)))

(define (db:set-state-status-by-state-status dbstruct run-id testname currstate currstatus newstate newstatus)


  ;; clear caches needed

  
  (let* ((qry (conc "UPDATE tests SET state=?,status=? WHERE "
		    (if currstate  (conc "state='" currstate "' AND ") "")
		    (if currstatus (conc "status='" currstatus "' AND ") "")
		    " run_id=? AND testname LIKE ?;")))
    (db:with-db
     dbstruct
     run-id
     #t
     (lambda (dbdat db)
       (sqlite3:execute db qry
			(or newstate  currstate "NOT_STARTED")
			(or newstatus currstate "UNKNOWN")
			run-id testname)))))


)

			   test-name))
	 (item-path    (db:test-get-item-path testdat))
	 (tl-test-id   (rmt:get-test-id run-id test-name ""))
         (tl-testdat   (rmt:get-test-info-by-id run-id test-id))
	 (new-state-eh #f)
	 (new-status-eh #f))
    (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) 
	(rmt:general-call 'set-test-start-time run-id test-id))
    (let* ((res (begin
		  (rmt:test-set-state-status run-id test-id state status comment) ;; this call sets the item state/status
		  (if (not (equal? item-path "")) ;; only roll up IF incoming test is an item
		      (let* ((state-status-counts (rmt:get-all-state-status-counts-for-test run-id test-name item-path state status)) ;; item-path is used to exclude current state/status of THIS test
			     (state-statuses      (db:roll-up-rules state-status-counts state status))
			     (newstate            (car state-statuses))
			     (newstatus           (cadr state-statuses)))

(define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
  (let* ((cfg-deadtime             (configf:lookup-number *configdat* "setup" "deadtime"))
	 (test-stats-update-period (configf:lookup-number *configdat* "setup" "test-stats-update-period")))
   (rmt:find-and-mark-incomplete-engine run-id ovr-deadtime cfg-deadtime test-stats-update-period)
   ;;call end of eud of run detection for posthook
   (launch:end-of-run-check run-id)))

;; set tests with state currstate and status currstatus to newstate and newstatus
;; use currstate = #f and or currstatus = #f to apply to any state or status respectively
;; WARNING: SQL injection risk. NB// See new but not yet used "faster" version below
;;
;;  AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
;;  (debug:print 0 *default-log-port* "QRY: " qry)
;;  (db:delay-if-busy)
;;
;; NB// This call only operates on toplevel tests. Consider replacing it with more general call
;;
(define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus)
  (let ((test-ids '()))
    (for-each
     (lambda (testname)
       (let ((test-id   (db:get-test-id dbstruct run-id testname "")))
	 (rmt:set-state-status-by-state-status run-id testname currstate currstatus newstate newstatus)
	 (if test-id
	     (begin
	       (set! test-ids (cons test-id test-ids))
	       (mt:process-triggers run-id test-id newstate newstatus)))))
     testnames)
    test-ids))

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

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

(define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode)
  (assert (number? run-id) "FATAL: Run id required.")
  ;; (if (number? run-id)
  (rmtmod:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals last-update mode)))
  ;;    (begin
  ;;	(debug:print-error 0 *default-log-port* "rmt:get-tests-for-run called with bad run-id=" run-id)

        (begin 
	  (debug:print 2 *default-log-port* "ERROR: cannot read " infile)
          (debug:print 2 *default-log-port* "ERROR: run-dir is " run-dir)
          #f
          )
        (with-input-from-file infile read-lines)
	)))

(define (rmt:set-state-status-by-state-status run-id testname currstate currstatus newstate newstatus)
  (rmtmod:send-receive 'set-state-status-by-state-status run-id (list run-id testname currstate currstatus newstate newstatus)))

  

)