@@ -48,157 +48,35 @@
 (include "test_records.scm")
 
 ;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
 ;; here.
 
-;;======================================================================
-;;  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))))
-
-(define (mt:get-run-stats dbstruct run-id)
-;;  Get run stats from local access, move this ... but where?
-  (db:get-run-stats dbstruct run-id))
-
-(define (mt:discard-blocked-tests run-id failed-test tests test-records)
-  (if (null? tests)
-      tests
-      (begin
-	(debug:print-info 1 *default-log-port* "Discarding tests from " tests " that are waiting on " failed-test)
-	(let loop ((testn (car tests))
-		   (remt  (cdr tests))
-		   (res   '()))
-	  (let* ((test-dat (hash-table-ref/default test-records testn (vector #f #f '())))
-		 (waitons  (vector-ref test-dat 2)))
-	    ;; (print "mt:discard-blocked-tests run-id: " run-id " failed-test: " failed-test " testn: " testn " with waitons: " waitons)
-	    (if (null? remt)
-		(let ((new-res (reverse res)))
-		  ;; (print "       new-res: " new-res)
-		  new-res)
-		(loop (car remt)
-		      (cdr remt)
-		      (if (member failed-test waitons)
-			  (begin
-			    (debug:print 0 *default-log-port* "Discarding test " testn "(" test-dat ") due to " failed-test)
-			    res)
-			  (cons testn res)))))))))
-
-;;======================================================================
-;;  T R I G G E R S
-;;======================================================================
-
-(define (mt:run-trigger cmd test-id test-rundir trigger logname test-name item-path event-time actual-state actual-status target runname)
-  ;; Putting the commandline into ( )'s means no control over the shell. 
-  ;; stdout and stderr will be caught in the NBFAKE or mt_launch.log files
-  ;; or equivalent. No need to do this. Just run it?
-  (let* ((new-trigger-format (configf:lookup *configdat* "setup" "new-trigger-format"))
-         (fullcmd 
-          (if (and new-trigger-format (string=? new-trigger-format "yes"))
-            (conc "nbfake "
-			cmd           " "
-			test-id       " "
-			test-rundir   " "
-			trigger       " "
-			actual-state  " "
-			actual-status " "
-			event-time    " "
-                        target        " "
-                        runname       " "
-			test-name     " "
-			item-path
-			)
-            (conc "nbfake "
-			cmd           " "
-			test-id       " "
-			test-rundir   " "
-			trigger       " "
-			test-name     " "
-			item-path     " " 
-			actual-state  " "
-			actual-status " "
-			event-time
-			)
-          ))
-	 (prev-nbfake-log (get-environment-variable "NBFAKE_LOG")))
-    (setenv "NBFAKE_LOG" (conc (cond
-				((and (directory-exists? test-rundir)
-				      (file-write-access? test-rundir))
-				 test-rundir)
-				((and (directory-exists? *toppath*)
-				      (file-write-access? *toppath*))
-				 *toppath*)
-				(else (conc "/tmp/" (current-user-name))))
-			       "/" logname))
-    (debug:print-info 0 *default-log-port* "TRIGGERED on " trigger ", running command " fullcmd " output at " (get-environment-variable "NBFAKE_LOG"))
-    (process-run fullcmd)
-    (if prev-nbfake-log
-	(setenv "NBFAKE_LOG" prev-nbfake-log)
-	(unsetenv "NBFAKE_LOG"))
-    ))
+(define (mt:lazy-read-test-config test-name)
+  (let ((tconf (hash-table-ref/default *testconfigs* test-name #f)))
+    (if tconf
+	tconf
+	(let ((test-dirs (tests:get-tests-search-path *configdat*)))
+	  (let loop ((hed (car test-dirs))
+		     (tal (cdr test-dirs)))
+	    ;; Setting MT_LINKTREE here is almost certainly unnecessary. 
+	    (let ((tconfig-file (conc hed "/" test-name "/testconfig")))
+	      (if (and (common:file-exists? tconfig-file)
+		       (file-read-access? tconfig-file))
+		  (let ((link-tree-path (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))
+			(old-link-tree  (get-environment-variable "MT_LINKTREE")))
+		    (if link-tree-path (setenv "MT_LINKTREE" link-tree-path))
+		    (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...]
+		      (hash-table-set! *testconfigs* test-name newtcfg)
+		      (if old-link-tree 
+			  (setenv "MT_LINKTREE" old-link-tree)
+			  (unsetenv "MT_LINKTREE"))
+		      newtcfg))
+		  (if (null? tal)
+		      (begin
+			(debug:print-error 0 *default-log-port* "No readable testconfig found for " test-name)
+			#f)
+		      (loop (car tal)(cdr tal))))))))))
 
 (define (mt:process-triggers dbstruct run-id test-id newstate newstatus)
   (if test-id 
       (let* ((test-dat      (db:get-test-info-by-id dbstruct run-id test-id)))
 	(if test-dat
@@ -259,76 +137,5 @@
 		     (pop-directory))
                     )) ;; )
 	      ;; (mutex-unlock! *triggers-mutex*)
 	      )))))
 
-;;======================================================================
-;;  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-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)))
-
-(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:lazy-read-test-config test-name)
-  (let ((tconf (hash-table-ref/default *testconfigs* test-name #f)))
-    (if tconf
-	tconf
-	(let ((test-dirs (tests:get-tests-search-path *configdat*)))
-	  (let loop ((hed (car test-dirs))
-		     (tal (cdr test-dirs)))
-	    ;; Setting MT_LINKTREE here is almost certainly unnecessary. 
-	    (let ((tconfig-file (conc hed "/" test-name "/testconfig")))
-	      (if (and (common:file-exists? tconfig-file)
-		       (file-read-access? tconfig-file))
-		  (let ((link-tree-path (common:get-linktree)) ;; (configf:lookup *configdat* "setup" "linktree"))
-			(old-link-tree  (get-environment-variable "MT_LINKTREE")))
-		    (if link-tree-path (setenv "MT_LINKTREE" link-tree-path))
-		    (let ((newtcfg (read-config tconfig-file #f #f))) ;; NOTE: Does NOT run [system ...]
-		      (hash-table-set! *testconfigs* test-name newtcfg)
-		      (if old-link-tree 
-			  (setenv "MT_LINKTREE" old-link-tree)
-			  (unsetenv "MT_LINKTREE"))
-		      newtcfg))
-		  (if (null? tal)
-		      (begin
-			(debug:print-error 0 *default-log-port* "No readable testconfig found for " test-name)
-			#f)
-		      (loop (car tal)(cdr tal))))))))))
-