ADDED   configfmod.scm
Index: configfmod.scm
==================================================================
--- /dev/null
+++ configfmod.scm
@@ -0,0 +1,173 @@
+;;======================================================================
+;; 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 configfmod))
+(declare (uses commonmod))
+
+(module configfmod
+	*
+	
+(import scheme chicken data-structures extras files ports)
+(use
+ (prefix base64 base64:)
+ (prefix dbi dbi:)
+ (prefix sqlite3 sqlite3:)
+ (srfi 18)
+ format
+ matchable
+ md5
+ message-digest
+ pkts
+ posix
+ regex
+ regex-case
+ sparse-vectors
+ srfi-1
+ srfi-13
+ srfi-69
+ stack
+ typed-records
+ directory-utils
+ z3
+ )
+
+(import commonmod)
+
+;;======================================================================
+;; move debug stuff to separate module then put these back where they belong
+;;======================================================================
+
+(define (common:get-testsuite-name)
+  (or (configf:lookup *configdat* "setup" "area-name") ;; megatest is a flexible tool, testsuite is too limiting a description.
+      (configf:lookup *configdat* "setup" "testsuite" )
+      (getenv "MT_TESTSUITE_NAME")
+      (pathname-file (or (if (string? *toppath* )
+			     (pathname-file *toppath*)
+			     #f)
+			 (common:get-toppath #f)))
+      "please-set-setup-area-name")) ;; (pathname-file (current-directory)))))
+
+(define (get-area-name configdat toppath #!optional (short #f))
+  ;; look up my area name in areas table (future)
+  ;; generate auto name
+  (conc (get-area-path-signature toppath short)
+	"-"
+	(common:get-testsuite-name toppath configdat)))
+
+(define (common:get-db-tmp-area . junk)
+  (if *db-cache-path*
+      *db-cache-path*
+      (if *toppath* ;; common:get-create-writeable-dir
+	  (handle-exceptions
+	      exn
+	      (begin
+		(debug:print-error 0 *default-log-port* "Couldn't create path to " *db-cache-path* ", exn=" exn)
+		(exit 1))
+	      (let* ((tsname (common:get-testsuite-name))
+		     (dbpath (common:get-create-writeable-dir
+			      (list (conc "/tmp/" (current-user-name)
+					  "/megatest_localdb/"
+					  tsname "/"
+					  (string-translate *toppath* "/" "."))
+				    (conc "/tmp/" (current-process-id) ;; just in case we have an issue with the dir by own user name
+					  "/megatest_localdb/"
+					  tsname
+					  (string-translate *toppath* "/" "."))
+				    ))))
+		(set! *db-cache-path* dbpath)
+		dbpath))
+	  #f)))
+
+(define (common:get-sync-lock-filepath)
+  (let* ((tmp-area     (common:get-db-tmp-area))
+         (lockfile     (conc tmp-area "/megatest.db.sync-lock")))
+    lockfile))
+    
+
+;;======================================================================
+;; lookup routines - replicated from configf
+;;======================================================================
+
+(define (configf:assoc-safe-add alist key val #!key (metadata #f))
+  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
+    (append newalist (list (if metadata
+			       (list key val metadata)
+			       (list key val))))))
+
+(define (configf:section-var-set! cfgdat section-name var value #!key (metadata #f))
+  (hash-table-set! cfgdat section-name
+		   (configf:assoc-safe-add
+		    (hash-table-ref/default cfgdat section-name '())
+		    var value metadata: metadata)))
+
+(define (configf:lookup cfgdat section var)
+  (if (hash-table? cfgdat)
+      (let ((sectdat (hash-table-ref/default cfgdat section '())))
+	(if (null? sectdat)
+	    #f
+	    (let ((match (assoc var sectdat)))
+	      (if match ;; (and match (list? match)(> (length match) 1))
+		  (cadr match)
+		  #f))
+	    ))
+      #f))
+
+;; use to have definitive setting:
+;;  [foo]
+;;  var yes
+;;
+;;  (configf:var-is? cfgdat "foo" "var" "yes") => #t
+;;
+(define (configf:var-is? cfgdat section var expected-val)
+  (equal? (configf:lookup cfgdat section var) expected-val))
+
+;; redefines
+(define config-lookup configf:lookup)
+
+;; safely look up a value that is expected to be a number, return
+;; a default (#f unless provided)
+;;
+(define (configf:lookup-number cfdat section varname #!key (default #f))
+  (let* ((val (configf:lookup *configdat* section varname))
+         (res (if val
+                  (string->number (string-substitute "\\s+" "" val #t))
+                  #f)))
+    (cond
+     (res  res)
+     (val  (debug:print 0 *default-log-port* "ERROR: no number found for [" section "], " varname ", got: " val))
+     (else default))))
+
+(define (configf:section-vars cfgdat section)
+  (let ((sectdat (hash-table-ref/default cfgdat section '())))
+    (if (null? sectdat)
+	'()
+	(map car sectdat))))
+
+(define (configf:get-section cfgdat section)
+  (hash-table-ref/default cfgdat section '()))
+
+(define (configf:set-section-var cfgdat section var val)
+  (let ((sectdat (configf:get-section cfgdat section)))
+    (hash-table-set! cfgdat section
+                     (configf:assoc-safe-add sectdat var val))))
+
+;;======================================================================the end
+
+)