Megatest

	(db:initialize db))
    (db:set-sync db)
    db))

;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling  proc idb . params)
  (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
  (let* ((db   (if idb idb (open-db)))




	 (res #f))
    (set! res (apply proc db params))
    (if (not idb)(sqlite3:finalize! db))
    (debug:print-info 11 "open-run-close-no-exception-handling END" )
    res))

(define (open-run-close-exception-handling proc idb . params)
  (debug:print-info 11 "open-run-close-exception-handling START, idb=" idb ", params=" params)
  (let ((runner (lambda ()
		  (let* ((db   (if idb idb (open-db)))
			 (res #f))
		    (set! res (apply proc db params))
		    (if (not idb)(sqlite3:finalize! db))
		    (debug:print-info 11 "open-run-close-no-exception-handling END" )
		    res))))
    (handle-exceptions
     exn
     (begin
       (debug:print 0 "EXCEPTION: database probably overloaded?")
       (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
       (print-call-chain)
       (thread-sleep! (random 120))
       (debug:print-info 0 "trying db call one more time....")
       (runner))
     (runner))))



(define open-run-close open-run-close-exception-handling)

(define *global-delta* 0)
(define *last-global-delta-printed* 0)

(define (open-run-close-measure  proc idb . params)

;;
(define (db:test-set-rundir! db run-id test-name item-path rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
   rundir run-id test-name item-path))




(define (db:test-set-rundir-by-test-id! db test-id rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE id=?"
   rundir test-id))

;; 
(define (db:test-get-rundir-from-test-id db test-id)
  (let ((res (hash-table-ref/default *test-paths* test-id #f)))
    (if res
	res
	(begin
	  (sqlite3:for-each-row
	   (lambda (tpath)
	     (set! res tpath))
	   db 
	   "SELECT rundir FROM tests WHERE id=?;"
	   test-id)
	  (hash-table-set! *test-paths* test-id res)
	  res))))




(define (db:test-set-log! db test-id logf)
  (if (string? logf)
      (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE id=?;"
		       logf test-id)
      (debug:print 0 "ERROR: db:test-set-log! called with non-string log file name " logf)))

;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()))
  (let* ((testpatt   (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "%"))

                               ELSE status
                               END WHERE id=?;")
    (rollup-tests-pass-fail "UPDATE tests 
                               SET fail_count=(SELECT count(id) FROM tests WHERE 
                                     run_id=? AND testname=? AND item_path != '' AND status='FAIL'),
                                   pass_count=(SELECT count(id) FROM tests WHERE 
                                     run_id=? AND testname=? AND item_path != '' AND (status='PASS' OR status='WARN' OR status='WAIVED'))
                               WHERE run_id=? AND testname=? AND item_path='';")))



(define db:special-queries   '(rollup-tests-pass-fail))
(define db:run-local-queries '(rollup-tests-pass-fail))

;; The queue is a list of vectors where the zeroth slot indicates the type of query to
;; apply and the second slot is the time of the query and the third entry is a list of 
;; values to be applied

		 data)
       (let outerloop ((special-qry #f)
		       (stmts       data))
	 (if special-qry
	     ;; handle a query that cannot be part of the grouped queries
	     (let* ((stmt-key (vector-ref special-qry 0))
		    (qry      (hash-table-ref queries stmt-key))
		    (params   (vector-ref speical-qry 2)))
	       (apply sqlite3:execute db qry params)
	       (if (not (null? stmts))
		   (outerloop #f stmts)))
	     ;; handle normal queries
	     (sqlite3:with-transaction 
	      db
	      (lambda ()

	   (debug:print 0 "WARNING: path given, " outputfile " is relative, prefixing with current directory")
	   (conc (current-directory) "/" outputfile)))
     results)
    ;; brutal clean up
    (system "rm -rf tempdir")))

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


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

;; (define (rdb:test-set-status-state test-id status state msg)
;;   (if *runremote*
;;       (let ((host (vector-ref *runremote* 0))
;; 	    (port (vector-ref *runremote* 1)))
;; 	(handle-exceptions
;; 	 exn
;; 	 (begin
;; 	   (debug:print 0 "EXCEPTION: rpc call failed?")
;; 	   (debug:print 0 "  " ((condition-property-accessor 'exn 'message) exn))
;; 	   (print-call-chain)
;; 	   (cdb:test-set-status-state test-id status state msg))
;; 	 ((rpc:procedure 'cdb:test-set-status-state host port) test-id status state msg)))
;;       (cdb:test-set-status-state test-id status state msg)))
;; 
;; (define (rdb:test-rollup-test_data-pass-fail test-id)
;;   (if *runremote*
;;       (let ((host (vector-ref *runremote* 0))
;; 	    (port (vector-ref *runremote* 1)))
;; 	((rpc:procedure 'cdb:test-rollup-test_data-pass-fail host port) test-id))
;;       (cdb:test-rollup-test_data-pass-fail test-id)))
;; 
;; (define (rdb:pass-fail-counts test-id fail-count pass-count)
;;   (if *runremote*
;;       (let ((host (vector-ref *runremote* 0))
;; 	    (port (vector-ref *runremote* 1)))
;; 	((rpc:procedure 'cdb:pass-fail-counts host port) test-id fail-count pass-count))
;;       (cdb:pass-fail-counts test-id fail-count pass-count)))
;; 
;; ;; currently forces a flush of the queue
;; (define (rdb:tests-register-test db run-id test-name item-path)
;;   (if *runremote*
;;       (let ((host (vector-ref *runremote* 0))
;; 	    (port (vector-ref *runremote* 1)))
;; 	((rpc:procedure 'cdb:tests-register-test host port) db run-id test-name item-path force-write: #t))
;;       (cdb:tests-register-test db run-id test-name item-path force-write: #t)))
;; 
;; (define (rdb:flush-queue)
;;   (if *runremote*
;;       (let ((host (vector-ref *runremote* 0))
;; 	    (port (vector-ref *runremote* 1)))
;; 	((rpc:procedure 'cdb:flush-queue host port)))
;;       (cdb:flush-queue)))
;;