Megatest

	     (dir-writable (file-write-access? parent-dir)))
	(if dir-writable
	    (let ((exists  (file-exists? fname))
		  (lock    (obtain-dot-lock fname 1 5 10))
		  (db      (sqlite3:open-database fname)))
	      (sqlite3:set-busy-handler! db (make-busy-timeout 136000))
	      (db:set-sync db) ;; (sqlite3:execute db "PRAGMA synchronous = 0;")
	      (if (not exists)
		  (initproc db)
		  (initproc db update-only: #t))
	      (release-dot-lock fname)
	      db)
	    (begin
	      (debug:print 0 "ERROR: no such db in non-writable dir " fname)
	      (sqlite3:open-database fname))))))

;; This routine creates the db. It is only called if the db is not already opened

	    do-not-open)
	rdb
	(let* ((dbpath       (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db"))
	       (dbexists     (file-exists? dbpath))
	       (inmem        (if local #f (db:open-inmem-db)))
	       (refdb        (if local #f (db:open-inmem-db)))
	       (db           (db:lock-create-open dbpath ;; this is the database physically on disk
















						 whatever-goes-here! ) ;; add strings db to rundb, not in use yet
	       ;;   )) ;; (sqlite3:open-database dbpath))
	       (olddb        (if *megatest-db*
				 *megatest-db* 
				 (let ((db (db:open-megatest-db)))
				   (set! *megatest-db* db)
				   db)))
	       (write-access (file-write-access? dbpath))

;; Open the classic megatest.db file in toppath
;;
(define (db:open-megatest-db)
  (let* ((dbpath       (conc *toppath* "/megatest.db"))
	 (dbexists     (file-exists? dbpath))
	 (db           (db:lock-create-open dbpath
					    (lambda (db update-only)
					      (db:initialize-main-db db update-only)
					      (db:initialize-run-id-db db update-only))))
	 (write-access (file-write-access? dbpath)))
    (if (and dbexists (not write-access))
	(set! *db-write-access* #f))
    (cons db dbpath)))

;; sync run to disk if touched
;;

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

(define (db:initialize-main-db dbdat update-only)
  (let* ((configdat (car *configinfo*))  ;; tut tut, global warning...
	 (keys     (keys:config-get-fields configdat))
	 (havekeys (> (length keys) 0))
	 (keystr   (keys->keystr keys))
	 (fieldstr (keys->key/field keys))
	 (db       (db:dbdat-get-db dbdat)))
    (if (not update-only)
	(for-each (lambda (key)
		    (let ((keyn key))
		      (if (member (string-downcase keyn)
				  (list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
					"pass_count"))
			  (begin
			    (print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table, you must remove your megatest.db and <linktree>/.db before trying again.")
			    (exit 1)))))
		  keys))
    (sqlite3:with-transaction
     db
     (lambda ()
       (sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
       (for-each (lambda (key)
		   (sqlite3:execute db "INSERT OR REPLACE INTO keys (fieldname,fieldtype) VALUES (?,?);" key "TEXT"))
		 keys)

       (sqlite3:execute db "INSERT OR REPLACE INTO metadat (var,val) VALUES (?,?);" "MEGATEST_VERSION" megatest-version)
       (debug:print-info 11 "db:initialize END")))))

;;======================================================================
;; R U N   S P E C I F I C   D B 
;;======================================================================

(define (db:initialize-run-id-db db update-only)
  (handle-exceptions
   exn
   (begin
     (release-dot-lock dbpath)
     (if (> attemptnum 2)
	 (debug:print 0 "ERROR: tried twice, cannot create/initialize db for run-id " run-id ", at path " dbpath)
	 (db:open-rundb dbstruct run-id attemptnum (+ attemptnum 1))))
   (db:initialize-run-id-db db)
  (sqlite3:with-transaction 
   db
   (lambda ()
     (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tests 
                    (id INTEGER PRIMARY KEY,
                     run_id       INTEGER   DEFAULT -1,
                     testname     TEXT      DEFAULT 'noname',

                              id           INTEGER PRIMARY KEY,
                              test_id      INTEGER,
                              update_time  TIMESTAMP,
                              cpuload      INTEGER DEFAULT -1,
                              diskfree     INTEGER DEFAULT -1,
                              diskusage    INTGER DEFAULT -1,
                              run_duration INTEGER DEFAULT 0);")))
   (sqlite3:execute 
    db
    "INSERT OR IGNORE INTO tests (id,run_id,testname,event_time,item_path,state,status) VALUES (?,?,'bogustest',strftime('%s','
                                                      (* run-id 30000) ;; allow for up to 30k tests per run
                                                      run-id)
                                                     ;; do a dummy query to test that the table exists and the db is truly readable
                                                     (sqlite3:execute db "SELECT * FROM tests WHERE id=?;" (* run-id 30000))
						     )))) ;; add strings db to rundb, not in use yet


  db)

;;======================================================================
;; L O G G I N G    D B 
;;======================================================================

(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))