Megatest

;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;;  to extract info from the structure returned
;;
;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames
;;
;; (define (db:get-run-ids-matching dbstruct keynames target res)
;; ;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
;;   (let* ((tmp      (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
;; 	 (keystr   (car tmp))
;; 	 (header   (cadr tmp))
;; 	 (res     '())
;; 	 (key-patt "")
;; 	 (runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
;; 	 (qry-str  #f)
;; 	 (keyvals  (if targpatt (keys:target->keyval keys targpatt) '())))
;;     (for-each (lambda (keyval)
;; 		(let* ((key    (car keyval))
;; 		       (patt   (cadr keyval))
;; 		       (fulkey (conc ":" key))
;; 		       (wildtype (if (substring-index "%" patt) "like" "glob")))
;; 		  (if patt
;; 		      (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
;; 		      (begin
;; 			(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
;; 			(exit 6)))))
;; 	      keyvals)
;;     (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time "
;; 			(if limit  (conc " LIMIT " limit)   "")
;; 			(if offset (conc " OFFSET " offset) "")
;; 			";"))
;;     (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
;;     (db:with-db dbstruct #f #f ;; reads db, does not write to it.
;; 		(lambda (db)
;; 		  (sqlite3:for-each-row
;; 		   (lambda (a . r)
;; 		     (set! res (cons (list->vector (cons a r)) res)))
;; 		   (db:get-db dbstruct #f)
;; 		   qry-str
;; 		   runnamepatt)))
;;     (vector header res)))

;; Get all targets from the db
;;
(define (db:get-targets dbstruct)
  (let* ((res       '())
	 (keys       (db:get-keys dbstruct))
	 (header     keys) ;; (map key:get-fieldname keys))

	     #f
	     (lambda (db)
	       (sqlite3:first-result
		db
		(conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		      (string-intersperse testnames "','")
		      "') AND NOT (uname = 'n/a' AND item_path='');")) ;; should this include the (uname = 'n/a' ...) ???
	       ))
	    0)))))
             ;; DEBUG FIXME - need to merge this v.155 query correctly   
             ;; AND testname in (SELECT testname FROM test_meta WHERE jobgroup=?)
             ;; AND NOT (uname = 'n/a' AND item_path = '');"

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)

;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
  (let* ((dbdat   (db:get-db dbstruct #f))
	 (db      (db:dbdat-get-db dbdat))
	 (keys    (db:get-keys db))
	 (selstr  (string-intersperse keys ","))
	 (qrystr  (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
	 (keyvals #f)
	 (tests-hash (make-hash-table)))
    ;; first look up the key values from the run selected by run-id
    (db:delay-if-busy dbdat)
    (sqlite3:for-each-row 
     (lambda (a . b)
       (set! keyvals (cons a b)))

	  ;; collect all matching tests for the runs then
	  ;; extract the most recent test and return that.
	  (debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals 
		       ", previous run ids found: " prev-run-ids)
	  (if (null? prev-run-ids) '()  ;; no previous runs? return null
	      (let loop ((hed (car prev-run-ids))
			 (tal (cdr prev-run-ids)))
		(let ((results (db:get-tests-for-run dbstruct hed (conc test-name "/" item-path) '() '() #f #f #f #f #f #f)))
		  (debug:print 4 "Got tests for run-id " run-id ", test-name " test-name 
			       ", item-path " item-path " results: " (intersperse results "\n"))
		  ;; Keep only the youngest of any test/item combination
		  (for-each 
		   (lambda (testdat)
		     (let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
			    (stored-test   (hash-table-ref/default tests-hash full-testname #f)))