Megatest

;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
(define (update-rundat runnamepatt numruns testnamepatt itemnamepatt keypatts)
  (let ((modtime (file-modification-time *db-file-path*)))
    (if (or (and (> modtime *last-db-update-time*)
		 (> (current-seconds)(+ *last-db-update-time* 5)))
	    (> *delayed-update* 0))
	(begin
	  (debug:print 4 "INFO: update-rundat runnamepatt: " runnamepatt " numruns: " numruns " testnamepatt: " testnamepatt " itemnamepatt: " itemnamepatt " keypatts: " keypatts)
	  (set! *please-update-buttons* #t)
	  (set! *last-db-update-time* modtime)
	  (set! *delayed-update* (- *delayed-update* 1))
	  (let* ((allruns     (rdb:get-runs *db* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2))
					   *start-run-offset* keypatts))
		 (header      (db:get-header allruns))
		 (runs        (db:get-rows   allruns))

  ;; (if (db:been-changed)
  (begin
    (update-rundat (hash-table-ref/default *searchpatts* "runname" "%") *num-runs*
		   (hash-table-ref/default *searchpatts* "test-name" "%")
		   (hash-table-ref/default *searchpatts* "item-name" "%")
		   (let ((res '()))
		     (for-each (lambda (key)
				 (if (not (equal? key "runname"))
				     (let ((val (hash-table-ref/default *searchpatts* key #f)))
				       (if val (set! res (cons (list key val) res))))))
			       *dbkeys*)
		     res))
    ; (db:set-db-update-time)
    ))

(cond 
 ((args:get-arg "-run")

(define (runs:get-std-run-fields keys remfields)
  (let* ((header    (append (map key:get-fieldname keys)
			    remfields))
	 (keystr    (conc (keys->keystr keys) ","
			  (string-intersperse remfields ","))))
    (list keystr header)))

;; make a query (fieldname like 'patt1' OR fieldname 
(define (db:patt->like fieldname pattstr #!key (comparator " OR "))
  (let ((patts (if (string? pattstr)
		   (string-split pattstr ",")
		   '(""))))
    (string-intersperse (map (lambda (patt)
			       (conc fieldname " LIKE '" patt "'"))
			     (if (null? patts)
				 '("")
				 patts))
			comparator)))

;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs db runpatt count offset keypatts)
  (let* ((res       '())
	 (keys       (db:get-keys db))



	 (runpattstr (db:patt->like "runname" runpatt))

	 (remfields  (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header     (append (map key:get-fieldname keys)
		             remfields))
	 (keystr     (conc (keys->keystr keys) ","
		           (string-intersperse remfields ",")))
	 (qrystr     (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
		           ;; Generate: " AND x LIKE 'keypatt' ..."
		           (if (null? keypatts) ""
		               (conc " AND "
		         	    (string-join 
		         	     (map (lambda (keypatt)
		         		    (let ((key  (car keypatt))
		         			  (patt (cadr keypatt)))
		         		      (db:patt->like key patt)))
		         		  keypatts)
		         	     " AND ")))
		           " ORDER BY event_time DESC "
		           (if (number? count)
		               (conc " LIMIT " count)
		               "")
		           (if (number? offset)

	 (states-str    (conc " state in ('" (string-intersperse states   "','") "')"))
	 (statuses-str  (conc " status in ('" (string-intersperse statuses "','") "')"))
	 (state-status-qry (if (or (not (null? states))
				   (not (null? states)))
			       (conc " AND " (if not-in "NOT" "") " (" states-str " AND " statuses-str ") ")
			       ""))
	 (qry      (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment "
			 " FROM tests WHERE run_id=? AND "
			 ;; testname like ? AND item_path LIKE ? " 
			 (db:patt->like "testname" testpatt) " AND "
			 (db:patt->like "item_path" itempatt)
			 state-status-qry
			 (case sort-by
			   ((rundir)     " ORDER BY length(rundir) DESC;")
			   ((event_time) " ORDER BY event_time ASC;")
			   (else         ";"))
			 )))
    (debug:print 8 "INFO: db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row 
     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
     qry
     run-id
     ;; (if testpatt testpatt "%")
     ;; (if itempatt itempatt "%"))
     )
    res))

;; this one is a bit broken BUG FIXME
(define (db:delete-test-step-records db run-id test-name itemdat)
  ;; Breaking it into two queries for better file access interleaving
  (let ((ids '()))
    (sqlite3:for-each-row (lambda (id)

	   (keys     (rdb:get-keys db))
	   (keynames (map key:get-fieldname keys)))
      (if (not (args:get-arg "-server"))
	  (server:client-setup db))
      ;; Each run
      (for-each 
       (lambda (run)
	 (debug:print 1 "Run: "
		(string-intersperse (map (lambda (x)
					   (db:get-value-by-header run header x))
					 keynames) "/")
		"/"
		(db:get-value-by-header run header "runname")
		" status: " (db:get-value-by-header run header "state"))
	 (let ((run-id (db:get-value-by-header run header "id")))
	   (let ((tests (rdb:get-tests-for-run db run-id testpatt itempatt '() '())))
	     ;; Each test
	     (for-each 
	      (lambda (test)
		(format #t
			"  Test: ~25a State: ~15a Status: ~15a Runtime: ~5@as Time: ~22a Host: ~10a\n"