@@ -25,10 +25,14 @@
 ;;======================================================================
 
 (declare (unit megatestmod))
 (declare (uses debugprint))
 (declare (uses mtargs))
+(declare (uses dbmod))
+(declare (uses dbfile))
+(declare (uses commonmod))
+(declare (uses configfmod))
 
 (use srfi-69)
 
 (module megatestmod
 	*
@@ -790,7 +794,230 @@
     (if targ
 	(or (configf:lookup config targ var)
 	    (configf:lookup config "default" var))
 	(configf:lookup config "default" var))))
 
-	
+;;;======================================================================
+;;  S T A T E   A N D   S T A T U S   F O R   T E S T S 
+;;======================================================================
+
+;; speed up for common cases with a little logic
+(define (mt:test-set-state-status-by-id run-id test-id newstate newstatus newcomment)
+  (if (not (and run-id test-id))
+      (begin
+	(debug:print-error 0 *default-log-port* "bad data handed to mt:test-set-state-status-by-id, run-id=" run-id ", test-id=" test-id ", newstate=" newstate)
+	(print-call-chain (current-error-port))
+	#f)
+      (begin
+	;; cond
+	;; ((and newstate newstatus newcomment)
+	;;  (rmt:general-call 'state-status-msg run-id newstate newstatus newcomment test-id))
+	;; ((and newstate newstatus)
+	;;  (rmt:general-call 'state-status run-id newstate newstatus test-id))
+	;; (else
+	;;  (if newstate   (rmt:general-call 'set-test-state   run-id newstate   test-id))
+	;;  (if newstatus  (rmt:general-call 'set-test-status  run-id newstatus  test-id))
+	;;  (if newcomment (rmt:general-call 'set-test-comment run-id newcomment test-id))))
+	(rmt:set-state-status-and-roll-up-items run-id test-id #f newstate newstatus newcomment)
+	;; (mt:process-triggers run-id test-id newstate newstatus)
+	#t)))
+
+(define (mt:test-set-state-status-by-testname-unless-completed run-id test-name item-path new-state new-status new-comment)
+  (let ((test-id (rmt:get-test-id run-id test-name item-path)))
+    (mt:test-set-state-status-by-id-unless-completed run-id test-id new-state new-status new-comment)))
+    
+(define (mt:test-set-state-status-by-id-unless-completed run-id test-id newstate newstatus newcomment)
+  (let* ((test-vec   (rmt:get-testinfo-state-status run-id test-id))
+         (state     (vector-ref test-vec 3)))
+    (if (equal? state "COMPLETED")
+        #t
+        (rmt:set-state-status-and-roll-up-items run-id test-id #f newstate newstatus newcomment))))
+
+
+  
+(define (mt:test-set-state-status-by-testname run-id test-name item-path new-state new-status new-comment)
+  ;(let ((test-id (rmt:get-test-id run-id test-name item-path)))
+  (rmt:set-state-status-and-roll-up-items run-id test-name item-path new-state new-status new-comment)
+  ;; (mt:process-triggers run-id test-id new-state new-status)
+  #t);)
+	;;(mt:test-set-state-status-by-id run-id test-id new-state new-status new-comment)))
+
+;;======================================================================
+;;  R U N S
+;;======================================================================
+
+;; runs:get-runs-by-patt
+;; get runs by list of criteria
+;; 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
+;;
+(define (mt:get-runs-by-patt keys runnamepatt targpatt)
+  (let loop ((runsdat  (rmt:get-runs-by-patt keys runnamepatt targpatt 0 500 #f 0))
+	     (res      '())
+	     (offset   0)
+	     (limit    500))
+    ;; (print "runsdat: " runsdat)
+    (let* ((header    (vector-ref runsdat 0))
+	   (runslst   (vector-ref runsdat 1))
+	   (full-list (append res runslst))
+	   (have-more (eq? (length runslst) limit)))
+      ;; (debug:print 0 *default-log-port* "header: " header " runslst: " runslst " have-more: " have-more)
+      (if have-more 
+	  (let ((new-offset (+ offset limit))
+		(next-batch (rmt:get-runs-by-patt keys runnamepatt targpatt offset limit #f 0)))
+	    (debug:print-info 4 *default-log-port* "More than " limit " runs, have " (length full-list) " runs so far.")
+	    (debug:print-info 0 *default-log-port* "next-batch: " next-batch)
+	    (loop next-batch
+		  full-list
+		  new-offset
+		  limit))
+	 (vector header full-list)))))
+
+;;======================================================================
+;;  T E S T S
+;;======================================================================
+
+(define (mt:get-tests-for-run run-id testpatt states status #!key (not-in #t) (sort-by 'event_time) (sort-order "ASC") (qryvals #f)(last-update #f))
+  (let loop ((testsdat (rmt:get-tests-for-run run-id testpatt states status 0 500 not-in sort-by sort-order qryvals last-update 'normal))
+	     (res      '())
+	     (offset   0)
+	     (limit    500))
+    (let* ((full-list (append res testsdat))
+	   (have-more (eq? (length testsdat) limit)))
+      (if have-more 
+	  (let ((new-offset (+ offset limit)))
+	    (debug:print-info 4 *default-log-port* "More than " limit " tests, have " (length full-list) " tests so far.")
+	    (loop (rmt:get-tests-for-run run-id testpatt states status new-offset limit not-in sort-by sort-order qryvals last-update 'normal)
+		  full-list
+		  new-offset
+		  limit))
+	  full-list))))
+
+(define (mt:lazy-get-prereqs-not-met run-id waitons ref-item-path #!key (mode '(normal))(itemmaps #f) )
+  (let* ((key    (list run-id waitons ref-item-path mode))
+	 (res    (hash-table-ref/default *pre-reqs-met-cache* key #f))
+	 (useres (let ((last-time (if (vector? res) (vector-ref res 0) #f)))
+		   (if last-time
+		       (< (current-seconds)(+ last-time 5))
+		       #f))))
+    (if useres
+	(let ((result (vector-ref res 1)))
+	  (debug:print 4 *default-log-port* "Using lazy value res: " result)
+	  result)
+	(let ((newres (rmt:get-prereqs-not-met run-id waitons ref-item-path mode: mode itemmaps: itemmaps)))
+	  (hash-table-set! *pre-reqs-met-cache* key (vector (current-seconds) newres))
+	  newres))))
+
+;; 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 (db:set-tests-state-status dbstruct run-id testnames currstate currstatus newstate newstatus)
+  (let ((test-ids '()))
+    (for-each
+     (lambda (testname)
+       (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 ?;"))
+	     (test-id (db:get-test-id dbstruct run-id testname "")))
+	 (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)))
+	 (if test-id
+	     (begin
+	       (set! test-ids (cons test-id test-ids))
+	       (mt:process-triggers dbstruct run-id test-id newstate newstatus)))))
+     testnames)
+    test-ids))
+
+;; ; This is to be the big daddy call NOPE: Replaced by db:set-state-status-and-roll-up-items
+;; ;
+;; define (db:test-set-state-status dbstruct run-id test-id state status msg)
+;;  (let ((dbdat  (db:get-subdb dbstruct run-id)))
+;;    (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
+;; 	(db:general-call dbdat 'set-test-start-time (list test-id)))
+;;    ;; (if msg
+;;    ;; 	(db:general-call dbdat 'state-status-msg (list state status msg test-id))
+;;    ;; 	(db:general-call dbdat 'state-status     (list state status test-id)))
+;;    (db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg)
+;;    ;; process the test_data table
+;;    (if (and test-id state status (equal? status "AUTO")) 
+;; 	(db:test-data-rollup dbstruct run-id test-id status))
+;;    (mt:process-triggers dbstruct run-id test-id state status)))
+
+;; state is the priority rollup of all states
+;; status is the priority rollup of all completed statesfu
+;;
+;; if test-name is an integer work off that as test-id instead of test-name test-path
+;;
+(define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
+  ;; establish info on incoming test followed by info on top level test
+  ;; BBnote - for mode itemwait, linkage between upstream test & matching item status is propagated to run queue in db:prereqs-not-met
+  (let* ((testdat      (if (number? test-name)
+			   (db:get-test-info-by-id dbstruct run-id test-name) ;; test-name is actually a test-id
+			   (db:keep-trying-until-true ;; in our threaded stuff this call could happen before the test is registered (maybe?)
+			    db:get-test-info
+			    (list dbstruct run-id test-name item-path)
+			    10)))
+	 (test-id      (db:test-get-id testdat))
+	 (test-name    (if (number? test-name)
+			   (db:test-get-testname testdat)
+			   test-name))
+	 (item-path    (db:test-get-item-path testdat))
+         (tl-testdat   (db:get-test-info dbstruct run-id test-name ""))
+         (tl-test-id   (if tl-testdat
+			   (db:test-get-id tl-testdat)
+			   #f))
+	 (new-state-eh #f)
+	 (new-status-eh #f))
+    (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) 
+	(db:general-call dbstruct run-id 'set-test-start-time (list test-id)))
+    (mutex-lock! *db-transaction-mutex*)
+    (db:with-db
+     dbstruct run-id #t
+     (lambda (dbdat db)
+       (let ((tr-res
+              (sqlite3:with-transaction
+               db
+               (lambda ()
+                 ;; NB// Pass the db so it is part fo the transaction
+                 (db:test-set-state-status-db db 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 (db:get-all-state-status-counts-for-test db 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)))
+		       (set! new-state-eh newstate)
+		       (set! new-status-eh newstatus)
+                       (debug:print 4 *default-log-port* "BB> tl-test-id="tl-test-id" ; "test-name":"item-path" newstate="newstate" newstatus="newstatus" len(sscs)="(length state-status-counts)  " state-status-counts: "
+				    (apply conc
+					   (map (lambda (x)
+						  (conc
+                     				   (with-output-to-string (lambda () (pp (dbr:counts->alist x)))) " | "))
+						state-status-counts))); end debug:print
+		       (if tl-test-id
+			   (db:test-set-state-status-db db run-id tl-test-id newstate newstatus #f)) ;; we are still in the transaction - must access the db and not the dbstruct
+		       ))))))
+         (mutex-unlock! *db-transaction-mutex*)
+         (if (and test-id state status (equal? status "AUTO")) 
+             (db:test-data-rollup dbstruct run-id test-id status))
+	 (if new-state-eh ;; moved from db:test-set-state-status
+	      (mt:process-triggers dbstruct run-id test-id new-state-eh new-status-eh))
+         tr-res)))))
+
+
 )