Megatest

(define (db:setup run-id #!key (local #f))
  (let* ((dbdir    (db:dbfile-path #f)) ;; (conc (configf:lookup *configdat* "setup" "linktree") "/.db"))
	 (dbstruct (make-dbr:dbstruct path: dbdir local: local)))
    dbstruct))

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

                              last_update INTEGER DEFAULT (strftime('%s','now')))")
  (sqlite3:execute maindb "CREATE TRIGGER  IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats
                             FOR EACH ROW
                               BEGIN 
                                 UPDATE run_stats SET last_update=(strftime('%s','now'))
                                   WHERE id=old.id;
                               END;"))

(define (db:cache-for-read-only source target)
	(let* ((toppath  (launch:setup))
		(cache-db (db:open-megatest-db path: target))
		(source-db (db:open-megatest-db path: source))
		(curr-time (current-seconds))
		(res '()))
		(print source-db)
		(begin
			(if (not (file-exists? target)) 
				((db:sync-tables (db:sync-main-list source-db) source-db cache-db)
				(db:sync-tables db:sync-tests-only source-db cache-db)
				(db:clean-up-rundb cache-db))
				((sqlite3:for-each-row
				     (lambda (id release runname state status owner event_time comment fail_count pass_count )
				       (set! res (cons (id release runname state status owner event_time comment fail_count pass_count ) res)))
				     (db:dbdat-get-db source-db)
				     "SELECT id, release, runname, state, status, owner, event_time, comment, fail_count, pass_count FROM runs;"))
				)
			(print res)
			(sqlite3:finalize! (db:dbdat-get-db cache-db))
		   ))
	)

;; options:
;;
;;  'killservers  - kills all servers
;;  'dejunk       - removes junk records
;;  'adj-testids  - move test-ids into correct ranges
;;  'old2new      - sync megatest.db records to .db/{main,1,2 ...}.db

	 servers))

    ;; clear out junk records
    ;;
    (if (member 'dejunk options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:clean-up mtdb)))	

    ;; adjust test-ids to fit into proper range
    ;;
    (if (member 'adj-testids options)
	(begin
	  (db:delay-if-busy mtdb)
	  (db:prep-megatest.db-for-migration mtdb)))