Megatest

    (mutex-lock! *incoming-mutex*)
    (set! *incoming-data* (cons (vector 'step-status
					(current-seconds)
					;; FIXME - this should not update the logfile unless it is specified.
					(list test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile "")))
				*incoming-data*))
    (mutex-unlock! *incoming-mutex*)
    (if (not *cache-on*)(db:write-cached-data db))
    ;; (if (not *cache-on*)(db:write-cached-data db))
    #t))

;;======================================================================
;; Extract ods file from the db
;;======================================================================

;; runspatt is a comma delimited list of run patterns

					    ;; (tmpfree  (get-df "/tmp")))
				     (begin
				       ;; (if (not (args:get-arg "-server"))
				       ;;	   (server:client-setup db))
				       ;; (if (not cpuload)  (begin (debug:print 0 "WARNING: CPULOAD not found.")  (set! cpuload "n/a")))
				       ;; (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
				       (set! kill-job? (test-get-kill-request db run-id test-name itemdat))
				       (test-set-meta-info db tdb run-id testname itemdat minutes: minutes)
				       (test-set-meta-info db tdb run-id test-name itemdat minutes: minutes)
				       ;; (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
				       (if kill-job? 
					   (begin
					     (mutex-lock! m)
					     (let* ((pid (vector-ref exit-info 0)))
					       (if (number? pid)
						   (begin

	      (let* ((have-resources  (runs:can-run-more-tests db test-record)) ;; look at the test jobgroup and tot jobs running
		     (prereqs-not-met (db:get-prereqs-not-met db run-id waitons item-path mode: testmode))
		     (fails           (calc-fails prereqs-not-met))
		     (non-completed   (calc-not-completed prereqs-not-met)))
		(debug:print 8 "INFO: have-resources: " have-resources " prereqs-not-met: " 
			     (string-intersperse 
			      (map (lambda (t)
				     (if (string? t)
					 (conc " WARNING: t is a string=" t )
				     (conc (db:test-get-state t)"/"(db:test-get-status t)))
					 (conc (db:test-get-state t)"/"(db:test-get-status t))))
				   prereqs-not-met) ", ") " fails: " fails)
		;; Don't know at this time if the test have been launched at some time in the past
		;; i.e. is this a re-launch?
		(cond
		 ((and have-resources
		       (or (null? prereqs-not-met)
			   (and (eq? testmode 'toplevel)

    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     tdb
     "SELECT count(id) FROM test_rundat;")
    res))

(define (test-set-meta-info db tdb run-id testname itemdat)
(define (test-set-meta-info db tdb run-id testname itemdat #!key (minutes #f))
  (let* ((num-records (test:tdb-get-rundat-count tdb))
	 (item-path   (item-list->path itemdat))
	 (cpuload  (get-cpu-load))
	 ;; (hostname (get-host-name))
	 (diskfree (get-df (current-directory))))
    (if (eq? (modulo num-records 10) 0) ;; every ten records update central
	(begin
	  (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE run_id=? AND testname=? AND item_path=?;"
			   cpuload
			   diskfree
			   run-id
			   testname
			   item-path)
	  (if (eq? num-records 0)
	      (begin
	      (sqlite3:execute db "UPDATE tests SET uname=?,hostname=? WHERE run_id=? AND testname=? AND item_path=?;"
			       (get-uname "-srvpio") (get-host-name) run-id testname item-path))))
		(sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE run_id=? AND testname=? AND item_path=?;"
		  	             (get-uname "-srvpio") (get-host-name) run-id testname item-path)
                (if minutes 
                    (sqlite3:execute db "UPDATE tests SET minutes=? WHERE run_id=? AND testname=? AND item_path=?;"
                                        minutes run-id testname item-path))))))
    (sqlite3:execute tdb "INSERT INTO test_rundat (cpuload,diskfree) VALUES (?,?);"
		     cpuload diskfree)))
	  

;;======================================================================
;; A R C H I V I N G
;;======================================================================