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))) + +)