;;======================================================================
;; Copyright 2017, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;;======================================================================
(declare (unit dbfile))
(module dbfile
*
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:)
posix typed-records srfi-18
srfi-69)
;;======================================================================
;; R E C O R D S
;;======================================================================
;; a single Megatest area with it's multiple dbs is
;; managed in a dbstruct
;;
(defstruct dbr:dbstruct
(areapath #f)
(homehost #f)
(read-only #f)
(subdbs (make-hash-table))
)
;; NOTE: Need one dbr:subdb per main.db, 1.db ...
;;
(defstruct dbr:subdb
(dbname #f) ;; .db/1.db
(mtdb #f) ;; mtrah/.db/1.db
;; (dbdats (make-hash-table)) ;; id => dbdat
(tmpdb #f) ;; /tmp/.../.db/1.db
(refndb #f) ;; /tmp/.../.db/1.db_ref
(dbstack #f) ;; stack for tmp db handles, do not initialize with a stack
(homehost #f) ;; not used yet
(on-homehost #f) ;; not used yet
(read-only #f)
(last-sync 0)
(last-write (current-seconds))
) ;; goal is to converge on one struct for an area but for now it is too confusing
;; need to keep dbhandles and cached statements together
(defstruct dbr:dbdat
(dbfile #f)
(dbh #f)
(stmt-cache (make-hash-table))
(read-only #f))
(define (dbfile:run-id->key run-id)
(or run-id 'main))
;; ;; set up a single db (e.g. main.db, 1.db ... etc.)
;; ;;
;; (define (db:setup-db dbstruct areapath run-id)
;; (let* ((dbname (db:run-id->dbname run-id))
;; (dbstruct (hash-table-ref/default dbstructs dbname #f)))
;; (if dbstruct
;; dbstruct
;; (let* ((dbstruct-new (make-dbr:dbstruct)))
;; (db:open-db dbstruct-new run-id areapath: areapath do-sync: #t)
;; (hash-table-set! dbstructs dbname dbstruct-new)
;; dbstruct-new))))
;; ; Returns the dbdat for a particular dbfile inside the area
;; ;;
;; (define (dbr:dbstruct-get-dbdat dbstruct dbfile)
;; (hash-table-ref/default (dbr:dbstruct-dbdats dbstruct) dbfile #f))
;;
;; (define (dbr:dbstruct-dbdat-put! dbstruct dbfile db)
;; (hash-table-set! (dbr:dbstruct-dbdats dbstruct) dbfile db))
;;
;; (define (db:run-id->first-num run-id)
;; (let* ((s (number->string run-id))
;; (l (string-length s)))
;; (substring s (- l 1) l)))
;; 1234 => 4/1234.db
;; #f => 0/main.db
;; (abandoned the idea of num/db)
;;
(define (db:run-id->path apath run-id)
(conc apath"/"(db:run-id->dbname run-id)))
(define (db:dbname->path apath dbname)
(conc apath"/"dbname))
(define (db:run-id->dbname run-id)
(cond
((number? run-id) (conc ".db/" (modulo run-id 100) ".db"))
((not run-id) (conc ".db/main.db"))
(else run-id)))
)