Megatest

;;======================================================================
;; Read-only cachedb cached direct from disk method
;;======================================================================

(define *dbmod:nfs-db-handles* (make-hash-table)) ;; dbfname -> dbstruct

;; called in rmt.scm nfs-transport-handler
(define (dbmod:nfs-get-dbstruct run-id keys init-proc areapath #!key (tmpadj ""))
  (assert areapath "FATAL: dbmod:nfs-get-dbstruct called without areapath set.")
  (let* ((dbfname  (dbmod:run-id->dbfname run-id))
	 (dbstruct (hash-table-ref/default *dbmod:nfs-db-handles* dbfname #f)))
    (if dbstruct
	dbstruct
	(let* ((newdbstruct (dbmod:open-dbmoddb areapath run-id dbfname init-proc keys syncdir: 'fromdisk tmpadj: tmpadj)))
	  (hash-table-set! *dbmod:nfs-db-handles* dbfname newdbstruct)
	  newdbstruct))))

;;======================================================================
;; The cachedb one-db file per server method goes in here
;;======================================================================

;; Returns dbstruct
;;
;; * This routine creates the db if not found
;; * Probably can get rid of the dbstruct-in
;; 
(define (dbmod:open-dbmoddb areapath run-id dbfname-in init-proc keys
			    #!key (dbstruct-in #f)
			    ;; (dbcontext 'megatest) ;; use dashboard to do the dashboard
			    (tmpadj  "")       ;; add to tmp path
			    (syncdir 'todisk)) ;; todisk is used when caching in /tmp and writing data back to MTRAH
  (let* ((dbstruct     (or dbstruct-in (make-dbr:dbstruct areapath: areapath)))
	 (dbfname      (or dbfname-in (dbmod:run-id->dbfname run-id)))
	 (dbpath       (dbmod:get-dbdir dbstruct))             ;; directory where all the .db files are kept
	 (dbfullname   (conc dbpath"/"dbfname)) ;; (dbmod:run-id->full-dbfname dbstruct run-id))
	 (dbexists     (file-exists? dbfullname))
	 (tmpdir       (dbfile:make-tmpdir-name areapath tmpadj))
	 (tmpdb        (let* ((fname (conc tmpdir"/"dbfname)))
			 fname))
	 (cachedb        (dbmod:open-cachedb-db init-proc
					    ;; (if (eq? (dbfile:cache-method) 'cachedb)
					    ;; 	#f
					    tmpdb
					    ;; )

    (dbr:dbstruct-dbtmpname-set! dbstruct tmpdb)
    (dbr:dbstruct-dbfname-set!   dbstruct dbfname)
    (dbr:dbstruct-sync-proc-set! dbstruct
				 (lambda (last-update)
				   (if *sync-in-progress*
				       (debug:print 3 *default-log-port* "WARNING: overlapping calls to sync to disk")
				       (let* ((syncer-logfile    (conc areapath"/logs/"dbfname"-syncer.log"))
					      (sync-cmd          (if (eq? syncdir 'todisk)
								     (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "tmpdb" -to "dbfullname" -period 5 -timeout 10 &")
								     (conc "NBFAKE_LOG="syncer-logfile" nbfake megatest -db2db -from "dbfullname" -to "tmpdb" -period 5 -timeout 10 &")))
					      (synclock-file     (conc dbfullname".lock"))
					      (syncer-running-file (conc dbfullname"-sync-running"))
					      (synclock-mod-time (if (file-exists? synclock-file)
								     (handle-exceptions
									 exn
								       #f
								       (file-modification-time synclock-file))

	       (dest-exists  (file-exists? destdbfile)))
	  (assert dest-exists "FATAL: sync called with non-existant file, "destdbfile)
	  ;; attach the destdbfile
	  ;; for each table
	  ;;    insert into dest.<table> select * from src.<table> where last_update>last_update
	  ;; done
	  (debug:print 0 *default-log-port* "Attaching "destdbfile" as auxdb")
	  (handle-exceptions
	      exn
	      (begin
		(debug:print 0 "ATTACH failed, exiting. exn="(condition->list exn))
		(exit 1))
	    (sqlite3:execute dbh (conc "ATTACH '"destdbfile"' AS auxdb;")))
	  (for-each
	   (lambda (table)
	     (let* ((tbldat (alist-ref table tables equal?))
		    (fields (map car tbldat))
		    (no-id-fields (filter (lambda (x)(not (equal? x "id"))) fields))
		    (fields-str (string-intersperse fields ","))
		    (no-id-fields-str (string-intersperse no-id-fields ","))