Index: common.scm
==================================================================
--- common.scm
+++ common.scm
@@ -7,11 +7,11 @@
 ;;  This program is distributed WITHOUT ANY WARRANTY; without even the
 ;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
 ;;  PURPOSE.
 ;;======================================================================
 
-(use srfi-1 posix regex-case base64 format dot-locking csv-xml z3 sql-de-lite hostinfo)
+(use srfi-1 posix regex-case base64 format dot-locking csv-xml z3 sql-de-lite hostinfo md5 message-digest)
 (require-extension regex posix)
 
 (require-extension (srfi 18) extras tcp rpc)
 
 (import (prefix sqlite3 sqlite3:))
@@ -364,10 +364,13 @@
   (or (configf:lookup *configdat* "setup" "testsuite" )
       (if *toppath* 
           (pathname-file *toppath*)
           (pathname-file (current-directory)))))
 
+(define (common:get-area-path-signature)
+  (message-digest-string (md5-primitive) *toppath*))
+
 ;;======================================================================
 ;; E X I T   H A N D L I N G
 ;;======================================================================
 
 (define (common:legacy-sync-recommended)
@@ -520,10 +523,31 @@
 	 (pathname-directory
 	  (pathname-directory 
 	   (pathname-directory exe-path))))
 	#f)))
 
+;; return first path that can be created or already exists and is writable
+;;
+(define (common:get-create-writeable-dir dirs)
+  (if (null? dirs)
+      #f
+      (let loop ((hed (car dirs))
+		 (tal (cdr dirs)))
+	(let ((res (or (and (directory? hed)
+			    (file-write-access? hed)
+			    hed)
+		       (handle-exceptions
+			exn
+			#f
+			(create-directory hed #t)))))
+	  (if (and (string? res)
+		   (directory? res))
+	      res
+	      (if (null? tal)
+		  #f
+		  (loop (car tal)(cdr tal))))))))
+  
 ;;======================================================================
 ;; T A R G E T S  ,   S T A T E ,   S T A T U S ,   
 ;;                    R U N N A M E    A N D   T E S T P A T T
 ;;======================================================================
 

Index: db.scm
==================================================================
--- db.scm
+++ db.scm
@@ -280,14 +280,14 @@
 		  db)
 		(begin
 		  (dbr:dbstruct-inmem-set!  dbstruct inmem)
 		  ;; dec 14, 2014 - keep deleted records available. hunch is that they are needed for id placeholders
 		  ;; (sqlite3:execute db "DELETE FROM tests WHERE state='DELETED';") ;; they just slow us down in this context
-		  (db:sync-tables db:sync-tests-only db inmem)
+		  (db:sync-tables db:sync-tests-only #f db inmem)
 		  (db:delay-if-busy refdb) ;; dbpath: (db:dbdat-get-path refdb)) ;; What does delaying here achieve? 
 		  (dbr:dbstruct-refdb-set!  dbstruct refdb)
-		  (db:sync-tables db:sync-tests-only inmem refdb) ;; use inmem as the reference, don't read again from db
+		  (db:sync-tables db:sync-tests-only #f inmem refdb) ;; use inmem as the reference, don't read again from db
 		  ;; sync once more to deal with delays?
 		  ;; (db:sync-tables db:sync-tests-only db inmem)
 		  ;; (db:sync-tables db:sync-tests-only inmem refdb)
 		  inmem)))))))
 
@@ -358,11 +358,11 @@
 		    (> mtime stime)
 		    force-sync)
 		(begin
 		  (db:delay-if-busy maindb)
 		  (db:delay-if-busy olddb)
-		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) maindb olddb)))
+		  (let ((num-synced (db:sync-tables (db:sync-main-list maindb) #f maindb olddb)))
 		    (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
 		    num-synced)
 		  0))
 	    (begin
 	      ;; this can occur when using local access (i.e. not in a server)
@@ -377,11 +377,11 @@
 		force-sync)
 	    (begin
 	      (db:delay-if-busy rundb)
 	      (db:delay-if-busy olddb)
 	      (dbr:dbstruct-stime-set! dbstruct (current-milliseconds))
-	      (let ((num-synced (db:sync-tables db:sync-tests-only inmem refdb rundb olddb)))
+	      (let ((num-synced (db:sync-tables db:sync-tests-only #f inmem refdb rundb olddb)))
 		;; (mutex-unlock! *http-mutex*)
 		num-synced)
 	      (begin
 		;; (mutex-unlock! *http-mutex*)
 		0))))))
@@ -576,11 +576,15 @@
 	 #t))))))
     
 ;; tbls is ( ("tablename" ( "field1" [#f|proc1] ) ( "field2" [#f|proc2] ) .... ) )
 ;; db's are dbdat's
 ;;
-(define (db:sync-tables tbls fromdb todb . slave-dbs)
+;; if last-update specified ("field-name" . time-in-seconds)
+;;    then sync only records where field-name >= time-in-seconds
+;;    IFF field-name exists
+;;
+(define (db:sync-tables tbls last-update fromdb todb . slave-dbs)
   (mutex-lock! *db-sync-mutex*)
   (handle-exceptions
    exn
    (begin
      (mutex-unlock! *db-sync-mutex*)
@@ -624,15 +628,26 @@
 	   (tot-count   0))
        (for-each ;; table
 	(lambda (tabledat)
 	  (let* ((tablename  (car tabledat))
 		 (fields     (cdr tabledat))
+		 (use-last-update  (if last-update
+				       (if (pair? last-update)
+					   (member (car last-update)    ;; last-update field name
+						   (map car fields))
+					   (begin
+					     (debug:print 0 *default-log-port* "ERROR: parameter last-update for db:sync-tables must be a pair, received: " last-update) ;; found in fields
+					     #f))
+				       #f))
 		 (num-fields (length fields))
 		 (field->num (make-hash-table))
 		 (num->field (apply vector (map car fields)))
 		 (full-sel   (conc "SELECT " (string-intersperse (map car fields) ",") 
-				   " FROM " tablename ";"))
+				   " FROM " tablename (if use-last-update ;; apply last-update criteria
+							  (conc " " (car last-update) ">=" (cdr last-update))
+							  "")
+				   ";"))
 		 (full-ins   (conc "INSERT OR REPLACE INTO " tablename " ( " (string-intersperse (map car fields) ",") " ) "
 				   " VALUES ( " (string-intersperse (make-list num-fields "?") ",") " );"))
 		 (fromdat    '())
 		 (fromdats   '())
 		 (totrecords 0)
@@ -705,11 +720,12 @@
 		  fromdats)
 		 (sqlite3:finalize! stmth)))
 	     (append (list todb) slave-dbs))))
 	tbls)
        (let* ((runtime      (- (current-milliseconds) start-time))
-	      (should-print (common:low-noise-print 120 "db sync" (> runtime 500)))) ;; low and high sync times treated as separate.
+	      (should-print (or (debug:debug-mode 12)
+				(common:low-noise-print 120 "db sync" (> runtime 500))))) ;; low and high sync times treated as separate.
 	 (if should-print (debug:print 3 *default-log-port* "INFO: db sync, total run time " runtime " ms"))
 	 (for-each 
 	  (lambda (dat)
 	    (let ((tblname (car dat))
 		  (count   (cdr dat)))
@@ -782,32 +798,54 @@
                                BEGIN 
                                  UPDATE run_stats SET last_update=(strftime('%s','now'))
                                    WHERE id=old.id;
                                END;"))
 
-(define (db:cache-for-read-only source target)
-  (let* ((toppath   (launch:setup))
-         (cache-db  (db:open-megatest-db path: target))
-         (source-db (db:open-megatest-db path: source))
-         (curr-time (current-seconds))
-         (res      '()))
-    (print source-db)
-    (begin
-      (if (not (file-exists? target)) 
-          ((db:sync-tables (db:sync-main-list source-db) source-db cache-db)
-           (db:sync-tables db:sync-tests-only source-db cache-db)
-           (db:clean-up-rundb cache-db))
-          ((sqlite3:for-each-row
-            (lambda (id release runname state status owner event_time comment fail_count pass_count )
-              (set! res (cons (id release runname state status owner event_time comment fail_count pass_count ) res)))
-            (db:dbdat-get-db source-db)
-            "SELECT id, release, runname, state, status, owner, event_time, comment, fail_count, pass_count FROM runs;"))
-          )
-      (print res)
-      (sqlite3:finalize! (db:dbdat-get-db cache-db))
-      ))
-  )
+(define *global-db-store* (make-hash-table))
+
+;; return the target db handle so it can be used
+;;
+(define (db:cache-for-read-only source target #!key (use-last-update #f))
+  (if (and (hash-table-ref/default *global-db-store* target #f)
+	   (>= (file-modification-time target)(file-modification-time source)))
+      (hash-table-ref *global-db-store* target)
+      (let* ((toppath   (launch:setup))
+	     (targ-db-last-mod (if (file-exists? target)
+				   (file-modification-time target)
+				   0))
+	     (cache-db  (or (hash-table-ref/default *global-db-store* target #f)
+			    (db:open-megatest-db path: target)))
+	     (source-db (db:open-megatest-db path: source))
+	     (curr-time (current-seconds))
+	     (res      '())
+	     (last-update (if use-last-update (cons "last_update" targ-db-last-mod) #f)))
+	(db:sync-tables (db:sync-main-list source-db) last-update source-db cache-db)
+	(db:sync-tables db:sync-tests-only last-update source-db cache-db)
+	(hash-table-set! *global-db-store* target cache-db)
+	cache-db)))
+
+;; call a proc with a cached db
+;;
+(define (db:call-with-cached-db proc . params)
+  ;; first cache the db in /tmp
+  (let* ((cname-part (conc "megatest_cache/" (common:get-testsuite-name)))
+	 (fname      (conc  (common:get-area-path-signature) ".db"))
+	 (cache-dir  (common:get-create-writeable-dir
+		      (list (conc "/tmp/" (current-user-name) "/" cname-part)
+			    (conc "/tmp/" (current-user-name) "-" cname-part)
+			    (conc "/tmp/" (current-user-name) "_" cname-part)))))
+    ;; (debug:print-info 0 *default-log-port* "Using cache dir " cache-dir)
+    (if (not cache-dir)
+	(begin
+	  (debug:print 0 *default-log-port* "ERROR: Failed to find an area to write the cache db")
+	  (exit 1))
+	(let* ((cache-db (db:cache-for-read-only
+			  (conc *toppath* "/megatest.db")
+			  (conc cache-dir "/" fname)
+			  use-last-update: #t)))
+	  (apply proc cache-db params)
+	  ))))
 
 ;; options:
 ;;
 ;;  'killservers  - kills all servers
 ;;  'dejunk       - removes junk records
@@ -855,11 +893,11 @@
 
     ;; sync runs, test_meta etc.
     ;;
     (if (member 'old2new options)
 	(begin
-	  (db:sync-tables (db:sync-main-list mtdb) mtdb (db:get-db dbstruct #f))
+	  (db:sync-tables (db:sync-main-list mtdb) #f mtdb (db:get-db dbstruct #f))
 	  (for-each 
 	   (lambda (run-id)
 	     (db:delay-if-busy mtdb)
 	     (let ((testrecs (db:get-all-tests-info-by-run-id mtdb run-id))
 		   (dbstruct (if toppath (make-dbr:dbstruct path: toppath local: #t) #f)))
@@ -910,15 +948,15 @@
                    (lambda ()
                      (let* ((fromdb (if toppath (make-dbr:dbstruct path: toppath local: #t) #f))
                             (frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
                        (if (eq? run-id 0)
                            (let ((maindb  (db:dbdat-get-db (db:get-db fromdb #f))))
-                             (db:sync-tables (db:sync-main-list dbstruct) (db:get-db fromdb #f) mtdb)
+                             (db:sync-tables (db:sync-main-list dbstruct) #f (db:get-db fromdb #f) mtdb)
                              (set! dead-runs (db:clean-up-maindb (db:get-db fromdb #f))))
                            (begin
                              ;; NB// must sync first to ensure deleted tests get marked as such in megatest.db
-                             (db:sync-tables db:sync-tests-only (db:get-db fromdb run-id) mtdb)
+                             (db:sync-tables db:sync-tests-only #f (db:get-db fromdb run-id) mtdb)
                              (db:clean-up-rundb (db:get-db fromdb run-id)))))
                      (set! count (+ count 1))
                      (debug:print 0 *default-log-port* "Finished clean up of "
                                   (if (eq? run-id 0)
                                       " main.db " (conc run-id ".db")) ", " count " of " total)))))

Index: megatest.scm
==================================================================
--- megatest.scm
+++ megatest.scm
@@ -1067,13 +1067,15 @@
 	       (testpatt    (common:args-get-testpatt #f))
 	       ;; (if (args:get-arg "-testpatt") 
 	       ;;  	        (args:get-arg "-testpatt") 
 	       ;;  	        "%"))
 	       (keys        (rmt:get-keys)) ;; (db:get-keys dbstruct))
-	       ;; (runsda   t  (db:get-runs dbstruct runpatt #f #f '()))
-	       (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
-			           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
+	       ;; (runsdat  (db:get-runs dbstruct runpatt #f #f '()))
+	;; (runsdat     (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
+	;; 		           	 #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
+	       (runsdat     (db:call-with-cached-db db:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) ;; (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target)
+						    #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment") 0))
 	       (runstmp     (db:get-rows runsdat))
 	       (header      (db:get-header runsdat))
 	       ;; this is "-since" support. This looks at last mod times of <run-id>.db files
 	       ;; and collects those modified since the -since time.
 	       (runs        (if (and (not (null? runstmp))
@@ -1139,11 +1141,11 @@
 		   (let* ((run-id  (db:get-value-by-header run header "id"))
 			  (runname (db:get-value-by-header run header "runname")) 
 			  (states  (string-split (or (args:get-arg "-state") "") ","))
 			  (statuses (string-split (or (args:get-arg "-status") "") ","))
 			  (tests   (if tests-spec
-				       (rmt:get-tests-for-run run-id testpatt states statuses #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
+				       (db:call-with-cached-db db:get-tests-for-run run-id testpatt states statuses #f #f #f 'testname 'asc ;; (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc 
 							     ;; use qryvals if test-spec provided
 							     (if tests-spec
 								 (string-intersperse adj-tests-spec ",")
 								 ;; db:test-record-fields
 								 #f)
@@ -1264,11 +1266,11 @@
 ;;					     "\n         rundir:   " (get-value-by-fieldname test test-field-index "") ;; (sdb:qry 'getstr ;; (filedb:get-path *fdb* 
 ;; 					     (db:test-get-rundir test) ;; )
 					     )
 				    ;; Each test
 				    ;; DO NOT remote run
-				    (let ((steps (rmt:get-steps-for-test run-id (db:test-get-id test)))) ;; (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
+				    (let ((steps (db:call-with-cached-db db:get-steps-for-test run-id (db:test-get-id test)))) ;; (db:get-steps-for-test dbstruct run-id (db:test-get-id test))))
 				      (for-each 
 				       (lambda (step)
 					 (format #t 
 						 "    Step: ~20a State: ~10a Status: ~10a Time ~22a\n"
 						 (tdb:step-get-stepname step)