Megatest

;; ;; 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)
  (let* ((hash-key (cons run-id test-id)))
    (hash-table-delete! *db:get-test-info-by-id-cache* hash-key)
    (hash-table-delete! *db:get-test-state-status-by-id-cache*hash-key))
  (db:with-db
   dbstruct
   run-id #t
   (lambda (dbdat db)
     (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment))))

(define (db:test-set-state-status-db db run-id test-id newstate newstatus newcomment)

   #f
   (lambda (dbdat db)
     (sqlite3:first-result
      db
      "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMOTEHOSTSTART','RUNNING','KILLREQ') AND run_id=?;")
     run-id)))

(define *db:get-test-id-cache* (make-hash-table))

;; map run-id, testname item-path to test-id
(define (db:get-test-id dbstruct run-id testname item-path)
  (let* ((hash-key    (list run-id testname item-path))
	 (cache-result (hash-table-ref/default *db:get-test-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
	(let* ((res (db:with-db
		     dbstruct
		     run-id
		     #f
		     (lambda (dbdat db)
		       (db:first-result-default
			db
			"SELECT id FROM tests WHERE testname=? AND item_path=? AND run_id=?;"
			#f ;; the default
			testname item-path run-id)))))
	  (if res (hash-table-set! *db:get-test-id-cache* hash-key (cons (current-seconds) res)))
	  res))))

;; overload the unused attemptnum field for the process id of the runscript or 
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
  (db:with-db
   dbstruct

  (let* ((run-ids (db:get-all-run-ids mtdb)))
    (for-each 
     (lambda (run-id)
       (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id)))
	 (db:prep-megatest.db-adj-test-ids (dbr:dbdat-dbh mtdb) run-id testrecs)))
     run-ids)))

(define *db:get-test-info-by-id-cache* (make-hash-table))

;; Get test data using test_id
;; 
(define (db:get-test-info-by-id dbstruct run-id test-id)
  (let* ((hash-key (cons run-id test-id))
	 (cache-result (hash-table-ref/default *db:get-test-info-by-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
	(db:with-db
	 dbstruct
	 run-id
	 #f
	 (lambda (dbdat db)
	   (let ((res #f))
	     (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	      (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update)
		;;                0    1       2      3      4        5       6      7        8     9     10      11          12          13           14         15          16
		(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived last-update)))
	      db
	      ;; (db:get-cache-stmth dbdat db
	      ;; 		    (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;"))
	      (conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=? AND run_id=?;")
	      test-id run-id)
	     (hash-table-set! *db:get-test-info-by-id-cache* hash-key res)
	     res))))))

(define *db:get-test-state-status-by-id-cache* (make-hash-table))

;; Get test state, status using test_id
;; 
(define (db:get-test-state-status-by-id dbstruct run-id test-id)
  (let* ((hash-key     (cons run-id test-id))
	 (cache-result (hash-table-ref/default *db:get-test-state-status-by-id-cache* hash-key #f)))
    (if cache-result
	(cdr cache-result)
	(db:with-db
	 dbstruct
	 run-id
	 #f
	 (lambda (dbdat db)
	   (let ((res   (cons #f #f)))
	     ;;	   (stmth (db:get-cache-stmth dbdat db "SELECT state,status FROM tests WHERE id=?;")))
	     (sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
	      (lambda (state status)
		(cons state status))
	      db
	      "SELECT state,status FROM tests WHERE id=? AND run_id=?;" ;; stmth try not compiling this one - yes, this fixed the bind issue
	      test-id run-id)
	     (hash-table-set! *db:get-test-state-status-by-id-cache* hash-key (cons (current-seconds) res)) 
	     res))))))

;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
;;
(define (db:get-test-info-by-ids dbstruct run-id test-ids)
  (db:with-db
   dbstruct

	      (db:keep-trying-until-true proc params (- tries 1)))
	    (begin
	      ;; (debug:print-info 0 *default-log-port* "proc never returned true, params="params)
	      (print"db:keep-trying-until-true proc never returned true, proc = " proc " params =" params " tries = " tries)
	      #f)))))
  
(define (db:get-test-info dbstruct run-id test-name item-path)
  (let* ((test-id (db:get-test-id dbstruct run-id test-name item-path)))
    (db:get-test-info-by-id dbstruct run-id test-id)))
;;  (db:with-db
;;   dbstruct
;;   run-id
;;   #f
;;   (lambda (dbdat db)
;;     (db:get-test-info-db db run-id test-name item-path))))

(define (db:get-test-info-db db run-id test-name item-path)
  (let ((res #f))
    (sqlite3:for-each-row
     (lambda (a . b)
       (set! res (apply vector a b)))
     db