Megatest

	      (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=? AND NOT (item_path='' AND testname in (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));")))
		;;(debug:print 0 "QRY: " qry)
		(sqlite3:execute db qry run-id newstate newstatus testname testname)))
	    testnames))

(define (db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile)
  (debug:print 4 "run-id: " run-id " test-name: " test-name)
  (let* ((state     (check-valid-items "state" state-in))
	 (status    (check-valid-items "status" status-in))
	 (testdat   (db:get-test-info db run-id test-name item-path)))
    (debug:print 5 "testdat: " testdat)
    (if (and testdat ;; if the section exists then force specification BUG, I don't like how this works.
	     (or (not state)(not status)))
	(debug:print 0 "WARNING: Invalid " (if status "status" "state")
	       " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
    (if testdat
	(let ((test-id (test:get-id testdat)))
	  ;; FIXME - this should not update the logfile unless it is specified.
	  (sqlite3:execute db 
			"INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,strftime('%s','now'),?,?);"
			test-id teststep-name state-in status-in (if comment comment "") (if logfile logfile ""))
	  #t) ;; fake out a #t - could be execute is returning something complicated
	(debug:print 0 "ERROR: Can't update " test-name " for run " run-id " -> no such test in db"))))


(define (db:delete-tests-in-state db run-id state)
  (sqlite3:execute db "DELETE FROM tests WHERE state=? AND run_id=?;" state run-id))

(define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment)
  (if newstate   (sqlite3:execute db "UPDATE tests SET state=?   WHERE id=?;" newstate   test-id))
  (if newstatus  (sqlite3:execute db "UPDATE tests SET status=?  WHERE id=?;" newstatus  test-id))
  (if newcomment (sqlite3:execute db "UPDATE tests SET comment=? WHERE id=?;" newcomment test-id)))





(define (db:get-count-tests-running db)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     db

    (debug:print 3 "qrystr: " qrystr)
    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    res))

















;;======================================================================
;; Tests meta data
;;======================================================================

;; read the record given a testname

	     (if (not (or parent-waiton-met item-waiton-met))
		 (set! result (cons waitontest-name result)))
	     ;; if the test is not found then clearly the waiton is not met...
	     (if (not ever-seen)(set! result (cons waitontest-name result)))))
	waitons)
      (delete-duplicates result))))




















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

;; runspatt is a comma delimited list of run patterns
;; keypatt-alist must contain *all* keys with an associated pattern: '( ("KEY1" "%") .. )
(define (db:extract-ods-file db outputfile keypatt-alist runspatt pathmod)

;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")


;;======================================================================
;; REMOTE DB ACCESS VIA RPC
;;======================================================================

;; (define (rdb:get-var db var)
;; (define (rdb:set-var db var val)
;; (define (rdb-get-keys db)
;; (define (rdb:get-value-by-header row header field)
;; (define (rruns:get-std-run-fields keys remfields)
;; (define (rdb:get-runs db runpatt count offset keypatts)
;; (define (rdb:get-num-runs db runpatt)
;; (define (rdb:get-run-info db run-id)
;; (define (rdb:set-comment-for-run db run-id comment)
;; (define (rdb:delete-run db run-id)
;; (define (rdb:update-run-event_time db run-id)
;; (define (rdb-get-tests-for-run db run-id testpatt itempatt states statuses)
;; (define (rdb:delete-test-step-records db run-id test-name itemdat)
;; (define (rdb:delete-test-records db test-id)

(define (rdb:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:set-tests-state-status host port)
	 run-id testnames currstate currstatus newstate newstatus))
      (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)))

(define (rdb:teststep-set-status! db run-id test-name teststep-name state-in status-in itemdat comment logfile)
  (print "teststep-set-status!:"  run-id test-name teststep-name state-in status-in itemdat comment logfile)
  (let ((item-path (item-list->path itemdat)))
    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:teststep-set-status! host port)
	   run-id test-name teststep-name state-in status-in item-path comment logfile)
	  (db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile)))))



;; (define (rdb:delete-tests-in-state db run-id state)
;; (define (rdb:test-set-state-status-by-id db test-id newstate newstatus newcomment)
;; (define (rdb:get-count-tests-running db)
;; (define (rdb:get-count-tests-running-in-jobgroup db jobgroup)
;; (define (rdb:estimated-tests-remaining db run-id)
;; (define (rdb:get-test-info db run-id testname item-path)
;; (define (rdb:get-test-data-by-id db test-id)
;; (define (rdb:test-set-comment db run-id testname item-path comment)
;; (define (rdb:test-set-rundir! db run-id testname item-path rundir)
;; (define (rdb:test-get-paths-matching db keynames target)


;; (define (rdb:test-get-test-records-matching db keynames target)
;; (define (rdb:testmeta-get-record db testname)
;; (define (rdb:testmeta-add-record db testname)
;; (define (rdb:testmeta-update-field db testname field value)
;; (define (rdb:csv->test-data db test-id csvdata)
;; (define (rdb:read-test-data db test-id categorypatt)
;; (define (rdb:load-test-data db run-id test-name itemdat)
;; (define (rdb:test-data-rollup db test-id status)
;; (define (rdb:get-prev-tol-for-test db test-id category variable)
;; (define (rdb:step-get-time-as-string vec)
;; (define (rdb:get-steps-for-test db test-id)
;; (define (rdb:get-steps-table db test-id)
;; (define (rdb-get-prereqs-not-met db run-id waiton)
;; (define (rdb:get-prereqs-not-met db run-id waitons ref-item-path)
;; (define (rdb:extract-ods-file db outputfile keypatt-alist runspatt pathmod)

				     (let* ((db       (open-db))
					    (cpuload  (get-cpu-load))
					    (diskfree (get-df (current-directory)))
					    (tmpfree  (get-df "/tmp")))
				       (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-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
				       (if kill-job? 
					   (begin
					     (mutex-lock! m)
					     (let* ((pid (vector-ref exit-info 0)))
					       (if (number? pid)
						   (begin
						     (debug:print 0 "WARNING: Request received to kill job (attempt # " kill-tries ")")

    ;;======================================================================
    ;; db specials here
    ;;======================================================================
    ;; ** set-tests-state-status
    (rpc:publish-procedure!
     'rdb:set-tests-state-status 
     (lambda (run-id testnames currstate currstatus newstate newstatus)
       ;; (debug:print 2 "rdb:set-tests-state-status newstate: " newstate " newstatus: " newstatus)
       (db:set-tests-state-status db run-id testnames currstate currstatus newstate newstatus)))

    (rpc:publish-procedure!
     'rdb:teststep-set-status!
     (lambda (run-id test-name teststep-name state-in status-in item-path comment logfile)
       ;; (debug:print 2 "rdb:teststep-state-set-status! test-name: " test-name " teststep-name: " teststep-name)
       (db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile)))











    (set! *rpc:listener* rpc:listener)
    (on-exit (lambda ()
	       (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port)
	       (sqlite3:finalize! db)))
    (thread-start! th1)
    (thread-join! th1))) ;; rpc:server)))

			   ;; this test is younger, store it in the hash
			   (hash-table-set! tests-hash full-testname testdat))))
		   results)
		  (if (null? tal)
		      (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
		      (loop (car tal)(cdr tal))))))))))


(define (test-set-status! db run-id test-name state status itemdat-or-path comment dat)
  (let* ((real-status status)
	 (item-path   (if (string? itemdat-or-path) itemdat-or-path (item-list->path itemdat-or-path)))
	 (testdat     (db:get-test-info db run-id test-name item-path))
	 (test-id     (if testdat (db:test-get-id testdat) #f))
	 (otherdat    (if dat dat (make-hash-table)))
	 ;; before proceeding we must find out if the previous test (where all keys matched except runname)

			     #f))
		       #f)))
    (if waived (set! real-status "WAIVED"))
    (debug:print 4 "real-status " real-status ", waived " waived ", status " status)

    ;; update the primary record IF state AND status are defined
    (if (and state status)
	(sqlite3:execute db "UPDATE tests SET state=?,status=?,event_time=strftime('%s','now') WHERE run_id=? AND testname=? AND item_path=?;" 
			 state real-status run-id test-name item-path))

    ;; if status is "AUTO" then call rollup
    (if (and test-id state status (equal? status "AUTO")) 
	(db:test-data-rollup db test-id status))

    ;; add metadata (need to do this way to avoid SQL injection issues)

		  diskfree
		  uname
		  runpath
		  run-id
		  testname
		  item-path)))

(define (test-update-meta-info db run-id testname itemdat minutes cpuload diskfree tmpfree)
  (let ((item-path (item-list->path itemdat)))
    (if (not item-path)(begin (debug:print 0 "WARNING: ITEMPATH not set.")   (set! item-path "")))
    ;; (let ((testinfo (db:get-test-info db run-id testname item-path)))
    ;;   (if (and (not (equal? (db:test-get-status testinfo) "COMPLETED"))
    ;;            (not (equal? (db:test-get-status testinfo) "KILLREQ"))
    (sqlite3:execute
     db
     "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE run_id=? AND testname=? AND item_path=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"
     cpuload
     diskfree
     minutes
     run-id
     testname
     item-path)))

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

(define (test:archive db test-id)
  #f)

(define (test:archive-tests db keynames target)
  #f)