Index: Makefile
==================================================================
--- Makefile
+++ Makefile
@@ -28,11 +28,11 @@
ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm \
subrun.scm portlogger.scm archive.scm env.scm \
diff-report.scm cgisetup/models/pgdb.scm
# module source files
-MSRCFILES = dbmod.scm
+MSRCFILES = dbmod.scm dbfile.scm
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm \
# mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm \
# rmtmod.scm apimod.scm
@@ -162,11 +162,11 @@
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm
tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o : run_records.scm
db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm
-db.o api.o : mofiles/dbmod.o
+db.o api.o : mofiles/dbmod.o mofiles/dbfile.o
tests.o tasks.o dashboard-tasks.o : task_records.scm
runs.o : test_records.scm
ADDED configfmod.scm
Index: configfmod.scm
==================================================================
--- /dev/null
+++ configfmod.scm
@@ -0,0 +1,75 @@
+;;======================================================================
+;; 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 .
+
+;;======================================================================
+
+(declare (unit configfmod))
+;; (declare (uses mtargs))
+;; (declare (uses debugprint))
+;; (declare (uses keysmod))
+
+(module configfmod
+*
+
+(import srfi-1
+
+;; scheme
+;;
+;; big-chicken ;; more of a reminder than anything ...
+;; chicken.base
+;; chicken.condition
+;; chicken.file
+;; chicken.io
+;; chicken.pathname
+;; chicken.port
+;; chicken.pretty-print
+;; chicken.process
+;; chicken.process-context
+;; chicken.process-context.posix
+;; chicken.sort
+;; chicken.string
+;; chicken.time
+;; chicken.eval
+;;
+;; debugprint
+;; (prefix mtargs args:)
+;; pkts
+;; keysmod
+;;
+;; (prefix base64 base64:)
+;; (prefix dbi dbi:)
+;; (prefix sqlite3 sqlite3:)
+;; (srfi 18)
+;; directory-utils
+;; format
+;; matchable
+;; md5
+;; message-digest
+;; regex
+;; regex-case
+;; sparse-vectors
+;; srfi-1
+;; srfi-13
+;; srfi-69
+;; stack
+;; typed-records
+;; z3
+
+ )
+)
+
Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -30,10 +30,11 @@
(import (prefix base64 base64:))
(declare (unit db))
(declare (uses common))
(declare (uses dbmod))
+(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
(declare (uses client))
(declare (uses mt))
@@ -44,74 +45,12 @@
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
(import dbmod)
-
-;;======================================================================
-;; R E C O R D S
-;;======================================================================
-
-;; each db entry is a pair ( db . dbfilepath )
-;; NOTE: Need one dbr:dbstruct per main.db, 1.db ...
-;;
-(defstruct dbr:dbstruct
- (dbname #f)
- (dbdats (make-hash-table)) ;; id => dbdat
- ;; (tmpdbs #f)
- ;; (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack
- ;; (mtdb #f)
- ;; (refndb #f)
- (homehost #f) ;; not used yet
- (on-homehost #f) ;; not used yet
- (read-only #f)
- ;; (stmt-cache (make-hash-table))
- ) ;; goal is to converge on one struct for an area but for now it is too confusing
-
-(defstruct dbr:dbdat
- (db #f) ;; should rename this to oddb for on disk db
- (tmpdb #f)
- (dbhstack #f) ;; do not init with a stack
- (last-sync 0)
- (last-write (current-seconds))
- (run-id #f)
- (fname #f))
-
-; 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))
-
-;; (let ((firstnum (if run-id
-;; (db:run-id->first-num run-id)
-;; "0")))
-;; (conc *toppath* "/.dbs/" ;; firstnum"/"
-;; (or run-id "main")".db")))
-
-(define (db:run-id->dbname run-id)
- (if (number? run-id)
- (conc ".db/" (modulo run-id 100) ".db")
- (conc ".db/main.db")))
-
+(import dbfile)
+
;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts
(state #f)
ADDED dbfile.scm
Index: dbfile.scm
==================================================================
--- /dev/null
+++ dbfile.scm
@@ -0,0 +1,89 @@
+;;======================================================================
+;; 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 .
+
+;;======================================================================
+
+(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
+;;======================================================================
+
+;; each db entry is a pair ( db . dbfilepath )
+;; NOTE: Need one dbr:dbstruct per main.db, 1.db ...
+;;
+(defstruct dbr:dbstruct
+ (dbname #f)
+ (dbdats (make-hash-table)) ;; id => dbdat
+ ;; (tmpdbs #f)
+ ;; (dbstack #f) ;; stack for tmp db handles, do not initialize with a stack
+ ;; (mtdb #f)
+ ;; (refndb #f)
+ (homehost #f) ;; not used yet
+ (on-homehost #f) ;; not used yet
+ (read-only #f)
+ ;; (stmt-cache (make-hash-table))
+ ) ;; goal is to converge on one struct for an area but for now it is too confusing
+
+(defstruct dbr:dbdat
+ (db #f) ;; should rename this to oddb for on disk db
+ (tmpdb #f)
+ (dbhstack #f) ;; do not init with a stack
+ (last-sync 0)
+ (last-write (current-seconds))
+ (run-id #f)
+ (fname #f))
+
+; 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)))
+
+)