ADDED   attic/records-vs-vectors-vs-coops.scm
Index: attic/records-vs-vectors-vs-coops.scm
==================================================================
--- /dev/null
+++ attic/records-vs-vectors-vs-coops.scm
@@ -0,0 +1,110 @@
+;;  Copyright 2006-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/>.
+
+;; (include "vg.scm")
+
+;; (declare (uses vg))
+
+(use foof-loop defstruct coops)
+
+(defstruct obj     type fill-color angle)
+
+(define (make-vg:obj)(make-vector 3))
+(define-inline (vg:obj-get-type         vec)    (vector-ref  vec 0))
+(define-inline (vg:obj-get-fill-color   vec)    (vector-ref  vec 1))
+(define-inline (vg:obj-get-angle        vec)    (vector-ref  vec 2))
+(define-inline (vg:obj-set-type!        vec val)(vector-set! vec 0 val))
+(define-inline (vg:obj-set-fill-color!  vec val)(vector-set! vec 1 val))
+(define-inline (vg:obj-set-angle!       vec val)(vector-set! vec 2 val))
+
+(use simple-exceptions)
+(define vgs:obj-exn (make-exception "wrong record type, expected vgs:obj." 'assert))
+(define (make-vgs:obj)(let ((v (make-vector 4)))(vector-set! v 0 'vgs:obj) v))
+(define-inline (vgs:obj-type             vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 1)(raise (vgs:obj-exn 'vgs:obj-type 'xpr))))
+(define-inline (vgs:obj-fill-color       vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 2)(raise (vgs:obj-exn 'vgs:obj-fill-color 'xpr))))
+(define-inline (vgs:obj-angle            vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 3)(raise (vgs:obj-exn 'vgs:obj-angle 'xpr))))
+(define-inline (vgs:obj-type-set!        vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 1 val)(raise (vgs:obj-exn 'type))))
+(define-inline (vgs:obj-fill-color-set!  vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 2 val)(raise (vgs:obj-exn 'fill-color))))
+(define-inline (vgs:obj-angle-set!       vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 3 val)(raise (vgs:obj-exn 'angle))))
+
+(define-class <vgc> ()
+  ((type)
+   (fill-color)
+   (angle)))
+
+
+;; first use raw vectors
+(print "Using vectors")
+(time
+ (loop ((for r (up-from 0 (to 255))))
+       (loop ((for g (up-from 0 (to 255))))
+	     (loop ((for b (up-from 0 (to 255))))
+		   (let ((obj (make-vg:obj)))
+		     (vg:obj-set-type! obj 'abc)
+		     (vg:obj-set-fill-color! obj "green")
+		     (vg:obj-set-angle! obj 135)
+		     (let ((a (vg:obj-get-type obj))
+			   (b (vg:obj-get-fill-color obj))
+			   (c (vg:obj-get-angle obj)))
+		       obj))))))
+
+;; first use raw vectors with safe mode
+(print "Using vectors (safe mode)")
+(time
+ (loop ((for r (up-from 0 (to 255))))
+       (loop ((for g (up-from 0 (to 255))))
+	     (loop ((for b (up-from 0 (to 255))))
+		   (let ((obj (make-vgs:obj)))
+		     ;; (badobj (make-vector 20)))
+		     (vgs:obj-type-set! obj 'abc)
+		     (vgs:obj-fill-color-set! obj "green")
+		     (vgs:obj-angle-set! obj 135)
+		     (let ((a (vgs:obj-type obj))
+			   (b (vgs:obj-fill-color obj))
+			   (c (vgs:obj-angle obj)))
+		       obj))))))
+
+;; first use defstruct
+(print "Using defstruct")
+(time
+ (loop ((for r (up-from 0 (to 255))))
+       (loop ((for g (up-from 0 (to 255))))
+	     (loop ((for b (up-from 0 (to 255))))
+		   (let ((obj (make-obj)))
+		     (obj-type-set! obj 'abc)
+		     (obj-fill-color-set! obj "green")
+		     (obj-angle-set! obj 135)
+		     (let ((a (obj-type obj))
+			   (b (obj-fill-color obj))
+			   (c (obj-angle obj)))
+		       obj))))))
+		   
+
+;; first use defstruct
+(print "Using coops")
+(time
+ (loop ((for r (up-from 0 (to 255))))
+       (loop ((for g (up-from 0 (to 255))))
+	     (loop ((for b (up-from 0 (to 255))))
+		   (let ((obj (make <vgc>)))
+		     (set! (slot-value obj 'type) 'abc)
+		     (set! (slot-value obj 'fill-color) "green")
+		     (set! (slot-value obj 'angle) 135)
+		     (let ((a (slot-value obj 'type))
+			   (b (slot-value obj 'fill-color))
+			   (c (slot-value obj 'angle)))
+		       obj))))))

Index: megamod.scm
==================================================================
--- megamod.scm
+++ megamod.scm
@@ -86,10 +86,11 @@
  spiffy
  spiffy-directory-listing
  spiffy-request-vars
  sql-de-lite
  srfi-1
+ srfi-4
  srfi-13
  srfi-18
  srfi-69
  stack
  stml2
@@ -157,10 +158,11 @@
 (include "keys-inc.scm")
 (include "launch-inc.scm")
 (include "margs-inc.scm")
 (include "mt-inc.scm")
 (include "ods-inc.scm")
+(include "pgdb-inc.scm")
 (include "process-inc.scm")
 (include "rmt-inc.scm")
 (include "runconfig-inc.scm")
 (include "runs-inc.scm")
 (include "server-inc.scm")

ADDED   pgdb-inc.scm
Index: pgdb-inc.scm
==================================================================
--- /dev/null
+++ pgdb-inc.scm
@@ -0,0 +1,651 @@
+;;======================================================================
+;; 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/>.
+
+;;======================================================================
+
+;; I don't know how to mix compilation units and modules, so no module here.
+;;
+;; (module pgdb
+;;     (
+;;      open-pgdb
+;;      )
+;; 
+;; (import scheme)
+;; (import data-structures)
+;; (import chicken)
+
+;; given a configdat lookup the connection info and open the db
+;;
+(define (pgdb:open configdat #!key (dbname #f)(dbispec #f))  
+  (let ((pgconf (or dbispec
+		    (args:get-arg "-pgsync")
+		    (if configdat
+			(configf:lookup configdat "ext-sync" (or dbname "pgdb"))
+			#f)
+		    )))
+    (if pgconf
+	(let* ((confdat (map (lambda (conf-item)
+			       (let ((parts (string-split conf-item ":")))
+				 (if (> (length parts) 1)
+				     (let ((key (car parts))
+					   (val (cadr parts)))
+				       (cons (string->symbol key) val))
+				     (begin
+				       (print "ERROR: Bad config setting " conf-item ", should be key:val")
+				       `(,(string->symbol (car parts)) . #f)))))
+			     (string-split pgconf)))
+	       (dbtype   (string->symbol (or (alist-ref 'dbtype confdat) "pg"))))
+	  (if (alist-ref 'dbtype confdat)
+	      (dbi:open dbtype (alist-delete 'dbtype confdat))))
+	#f)))
+
+;;======================================================================
+;;  A R E A S
+;;======================================================================
+
+(defstruct area id area-name area-path last-update)
+
+(define (pgdb:add-area dbh area-name area-path)
+  (dbi:exec dbh "INSERT INTO areas (area_name,area_path) VALUES (?,?)" area-name area-path))
+
+(define (pgdb:get-areas dbh)
+  ;; (map
+  ;;  (lambda (row)
+  ;;    (print "row: " row))
+  (dbi:get-rows dbh "SELECT id,area_name,area_path,last_sync FROM areas;")) ;; )
+
+;; given an area_path get the area info
+;;
+(define (pgdb:get-area-by-path dbh area-path)
+  (dbi:get-one-row dbh "SELECT id,area_name,area_path,last_sync FROM areas WHERE area_path=?;" area-path))
+
+(define (pgdb:write-sync-time dbh area-info new-sync-time)
+  (let ((area-id (vector-ref area-info 0)))
+    (dbi:exec dbh "UPDATE areas SET last_sync=? WHERE id=?;" new-sync-time area-id)))
+
+;;======================================================================
+;;  T A R G E T S
+;;======================================================================
+
+;; Given a target-spec, return the id. Should probably handle this with a join...
+;; if target-spec not found, create a record for it.
+;;
+(define (pgdb:get-ttype dbh target-spec)
+  (let ((spec-id (dbi:get-one dbh "SELECT id FROM ttype WHERE target_spec=?;" target-spec)))
+    (or spec-id
+	(if (handle-exceptions
+		exn
+		(begin
+		  (print-call-chain)
+		  (debug:print 0 *default-log-port* "ERROR: cannot create ttype entry, " ((condition-property-accessor 'exn 'message) exn))
+		  #f)
+	      (dbi:exec dbh "INSERT INTO ttype (target_spec) VALUES (?);" target-spec))
+	    (pgdb:get-ttype dbh target-spec)))))
+
+;;======================================================================
+;;  T A G S
+;;======================================================================
+
+
+(define (pgdb:get-tag-info-by-name dbh tag)
+  (dbi:get-one-row dbh "SELECT id,tag_name FROM tags where tag_name=?;" tag))
+
+(define (pgdb:insert-tag dbh name )
+  (dbi:exec dbh "INSERT INTO tags (tag_name) VALUES (?)" name ))
+
+(define (pgdb:insert-area-tag dbh tag-id area-id )
+  (dbi:exec dbh "INSERT INTO area_tags (tag_id, area_id) VALUES (?,?)" tag-id area-id ))
+
+(define (pgdb:insert-run-tag dbh tag-id run-id )
+  (dbi:exec dbh "INSERT INTO run_tags (tag_id, run_id) VALUES (?,?)" tag-id run-id ))
+
+
+(define (pgdb:is-area-taged dbh area-id)
+   (let ((area-tag-id (dbi:get-one dbh "SELECT id FROM area_tags WHERE area_id=?;" area-id)))
+   (if area-tag-id 
+           #t
+            #f)))
+
+(define (pgdb:is-area-taged-with-a-tag dbh   tag-id area-id)
+   (let ((area-tag-id (dbi:get-one dbh "SELECT id FROM area_tags WHERE area_id=? and tag_id=?;" area-id tag-id)))
+   (if area-tag-id 
+           #t
+            #f)))
+
+(define (pgdb:is-run-taged-with-a-tag dbh   tag-id run-id)
+   (let ((run-tag-id (dbi:get-one dbh "SELECT id FROM run_tags WHERE run_id=? and tag_id=?;" run-id tag-id)))
+   (if run-tag-id 
+           #t
+            #f)))
+
+
+
+;;======================================================================
+;;  R U N S
+;;======================================================================
+
+;; given a target spec id, target and run-name return the run-id
+;; if no run found return #f
+;;
+(define (pgdb:get-run-id dbh spec-id target run-name area-id)
+  (dbi:get-one dbh "SELECT id FROM runs WHERE ttype_id=? AND target=? AND run_name=? and area_id=?;"
+	       spec-id target run-name area-id))
+
+;; given a target spec id, target and run-name return the run-id
+;; if no run found return #f
+;;
+(define (pgdb:get-run-last-update dbh id )
+  (dbi:get-one dbh "SELECT last_update FROM runs WHERE id=?;"
+	        id))
+
+;; given a run-id return all the run info
+;;
+(define (pgdb:get-run-info dbh run-id ) ;; to join ttype or not?
+  (dbi:get-one-row
+   dbh   ;; 0    1       2       3      4     5      6       7        8         9         10          11         12
+   "SELECT id,target,ttype_id,run_name,state,status,owner,event_time,comment,fail_count,pass_count,last_update,area_id
+       FROM runs WHERE id=? ;" run-id ))
+
+;; refresh the data in a run record
+;;
+(define (pgdb:refresh-run-info dbh run-id state status owner event-time comment fail-count pass-count area-id last_update publish-time) ;; area-id)
+  (dbi:exec
+   dbh
+   "UPDATE runs SET
+      state=?,status=?,owner=?,event_time=?,comment=?,fail_count=?,pass_count=?,last_update=?,publish_time=?  
+     WHERE id=? and area_id=?;"
+   state status owner event-time comment fail-count pass-count last_update publish-time run-id area-id ))
+
+;; given all needed info create run record
+;;
+(define (pgdb:insert-run dbh ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time)
+    (dbi:exec
+   dbh
+   "INSERT INTO runs (ttype_id,target,run_name,state,status,owner,event_time,comment,fail_count,pass_count,area_id,last_update,publish_time)
+      VALUES (?,?,?,?,?,?,?,?,?,?,?,?, ?);"
+    ttype-id target run-name state status owner event-time comment fail-count pass-count area-id last-update publish-time))
+
+;;======================================================================
+;;  T E S T - S T E P S
+;;======================================================================
+
+(define (pgdb:get-test-step-id dbh test-id stepname state)
+  (dbi:get-one
+    dbh
+    "SELECT id FROM test_steps WHERE test_id=? AND stepname=? and state = ? ;"
+    test-id stepname state))
+
+(define (pgdb:get-test-step-last-update dbh id )
+  (dbi:get-one
+    dbh
+    "SELECT last_update FROM test_steps WHERE id=? ;"
+    id))
+
+(define (pgdb:insert-test-step dbh test-id stepname state status event_time comment logfile last-update )
+  (dbi:exec
+   dbh
+   "INSERT INTO test_steps (test_id,stepname,state,status,event_time,logfile,comment,last_update)
+       VALUES (?,?,?,?,?,?,?,? );"
+   test-id stepname  state   status  event_time   logfile   comment last-update))
+
+(define (pgdb:update-test-step dbh step-id test-id stepname state status event_time comment logfile last-update)
+  (dbi:exec
+    dbh
+    "UPDATE test_steps SET
+         test_id=?,stepname=?,state=?,status=?,event_time=?,logfile=?,comment=?,last_update=?
+          WHERE id=?;"
+    test-id stepname  state   status  event_time   logfile   comment last-update step-id))
+
+
+;;======================================================================
+;;  T E S T - D A T A
+;;======================================================================
+
+(define (pgdb:get-test-data-id dbh test-id category variable)
+  (dbi:get-one
+    dbh
+    "SELECT id FROM test_data WHERE test_id=? AND category=? and variable = ? ;"
+    test-id category variable))
+
+(define (pgdb:get-test-data-last-update dbh test-data-id )
+  (dbi:get-one
+    dbh
+    "SELECT last_update FROM test_data WHERE id=? ;"
+    test-data-id))
+
+(define (pgdb:insert-test-data dbh test-id category variable value expected tol units comment status type last-update)
+ ; (print "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type)
+ ;      VALUES (?,?,?,?,?,?,?,?,?,?) " test-id " " category " " variable " " value " "  expected " "  tol " "  units " " comment  " " status  " " type)
+  (if (not (string? units))
+      (set! units "" ))
+  (if (not (string? variable))
+      (set! variable "" ))
+  (if (not (real? value))
+      (set! value 0 ))
+  (if (not (real? expected))
+      (set! expected 0  ))
+(if (not (real? tol))
+      (set! tol 0  ))
+
+  (dbi:exec
+   dbh
+   "INSERT INTO test_data (test_id, category, variable, value, expected, tol, units, comment, status, type, last_update)
+       VALUES (?,?,?,?,?,?,?,?,?,?, ?);"
+   test-id category variable value expected tol units comment status type last-update))
+
+(define (pgdb:update-test-data dbh data-id test-id  category variable value expected tol units comment status type last-update)
+  (dbi:exec
+    dbh
+    "UPDATE test_data SET
+         test_id=?, category=?, variable=?, value=?, expected=?, tol=?, units=?, comment=?, status=?, type=?, last_update=?
+          WHERE id=?;"
+    test-id category variable value expected tol units comment status type last-update data-id ))
+
+
+
+;;======================================================================
+;;  T E S T S
+;;======================================================================
+
+;; given run-id, test_name and item_path return test-id
+;;
+(define (pgdb:get-test-id dbh run-id test-name item-path)
+  (dbi:get-one
+   dbh
+   "SELECT id FROM tests WHERE run_id=? AND test_name=? AND item_path=?;"
+   run-id test-name item-path))
+
+(define (pgdb:get-test-last-update dbh id)
+  (dbi:get-one
+   dbh
+   "SELECT last_update FROM tests WHERE id=? ;"
+   id ))
+
+
+;; create new test record
+;;
+(define (pgdb:insert-test dbh run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid)
+  (dbi:exec
+   dbh
+   "INSERT INTO tests (run_id,test_name,item_path,state,status,host,cpuload,diskfree,uname,rundir,final_logf,run_duration,comment,event_time,archived,last_update,attemptnum)
+       VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);"
+
+   run-id  test-name item-path    state   status     host  cpuload diskfree uname
+   run-dir log-file  run-duration comment event-time archived last-update pid))
+
+;; update existing test record
+;;
+(define (pgdb:update-test dbh test-id run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived last-update pid)
+  (dbi:exec
+   dbh
+   "UPDATE tests SET
+      run_id=?,test_name=?,item_path=?,state=?,status=?,host=?,cpuload=?,diskfree=?,uname=?,rundir=?,final_logf=?,run_duration=?,comment=?,event_time=?,archived=?,last_update=?,attemptnum=?
+    WHERE id=?;"
+
+   run-id  test-name item-path    state   status     host  cpuload diskfree uname
+   run-dir log-file  run-duration comment event-time archived last-update pid test-id))
+
+(define (pgdb:get-tests dbh target-patt)
+  (dbi:get-rows
+   dbh
+   "SELECT t.id,t.run_id,t.test_name,t.item_path,t.state,t.status,t.host,t.cpuload,t.diskfree,t.uname,t.rundir,t.final_logf,t.run_duration,t.comment,t.event_time,t.archived,
+           r.id,r.target,r.ttype_id,r.run_name,r.state,r.status,r.owner,r.event_time,r.comment
+     FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+      WHERE r.target LIKE ?;" target-patt))
+
+(define (pgdb:get-stats-given-type-target dbh ttype-id target-patt)
+  (dbi:get-rows
+   dbh
+   ;;    "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+   ;;         WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;"
+   "SELECT r.target,COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target;"
+   ttype-id target-patt))
+
+(define (pgdb:get-stats-given-target dbh target-patt)
+  (dbi:get-rows
+   dbh
+   ;;    "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+   ;;         WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;"
+   "SELECT r.target,COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE t.state='COMPLETED' AND r.target LIKE ? GROUP BY r.target;"
+   target-patt))
+
+
+(define (pgdb:get-latest-run-stats-given-target dbh ttype-id target-patt limit offset)
+  (dbi:get-rows
+   dbh
+   ;;    "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+   ;;         WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;"
+   "SELECT r.target, r.event_time, COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other, r.id
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE t.state like '%'  AND ttype_id=? AND r.target LIKE ? 
+                 and r.id in 
+           (SELECT DISTINCT on (target) id from runs where target like ? AND ttype_id=? order by target,event_time desc) 
+          GROUP BY r.target,r.id 
+          order by r.event_time desc limit ? offset ? ;"
+   ttype-id target-patt target-patt ttype-id limit offset))
+
+(define (pgdb:get-latest-run-stats-given-pattern dbh patt limit offset)
+  (dbi:get-rows
+   dbh
+   ;;    "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+   ;;         WHERE t.state='COMPLETED' AND ttype_id=? AND r.target ILIKE ? GROUP BY r.target,t.status;"
+   "SELECT r.target, r.event_time, COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other, r.id
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE t.state like '%'  AND r.target ILIKE ? 
+                 and r.id in 
+           (SELECT DISTINCT on (target) id from runs where target ilike ?  order by target,event_time desc) 
+          GROUP BY r.target,r.id 
+          order by r.event_time desc limit ? offset ? ;"
+   patt patt  limit offset))
+
+
+(define (pgdb:get-count-data-stats-target-latest dbh ttype-id target-patt)
+  (dbi:get-rows
+   dbh
+    "SELECT count(*)  from 
+          (SELECT DISTINCT on (target) id 
+		from runs where target like ? AND ttype_id = ? 
+		order by target, event_time desc
+          ) as x;" 
+    target-patt ttype-id))
+
+(define  (pgdb:get-latest-run-cnt dbh ttype-id target-patt)
+  (let* ((cnt-result (pgdb:get-count-data-stats-target-latest dbh ttype-id target-patt))
+         ;(cnt-row (car (cnt-result)))
+         (cnt 0) 
+       )
+    (for-each
+     (lambda (row)
+      (set! cnt  (vector-ref row 0 ))) 
+     cnt-result)
+
+cnt))
+
+(define (pgdb:get-count-data-stats-latest-pattern dbh patt)
+  (dbi:get-rows
+   dbh
+    "SELECT count(*)  from 
+          (SELECT DISTINCT on (target) id 
+		from runs where target ilike ?  
+		order by target, event_time desc
+          ) as x;" 
+    patt))
+
+(define  (pgdb:get-latest-run-cnt-by-pattern dbh target-patt)
+  (let* ((cnt-result (pgdb:get-count-data-stats-latest-pattern dbh target-patt))
+         ;(cnt-row (car (cnt-result)))
+         (cnt 0) 
+       )
+    (for-each
+     (lambda (row)
+      (set! cnt  (vector-ref row 0 ))) 
+     cnt-result)
+
+cnt))
+
+
+
+
+
+(define (pgdb:get-run-stats-history-given-target dbh ttype-id target-patt)
+  (dbi:get-rows
+   dbh
+   ;;    "SELECT COUNT(t.id),t.status,r.target FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+   ;;         WHERE t.state='COMPLETED' AND ttype_id=? AND r.target LIKE ? GROUP BY r.target,t.status;"
+   "SELECT r.run_name,COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE t.state like '%'  AND ttype_id=? AND r.target LIKE ? 
+                 GROUP BY r.run_name;"
+   ttype-id target-patt ))
+
+(define (pgdb:get-all-run-stats-target-slice dbh target-patt limit offset)
+    (dbi:get-rows
+    dbh
+    "SELECT  r.target, r.run_name,r.event_time, COUNT(*) AS total,
+                    SUM(CASE WHEN t.status='PASS' THEN 1 ELSE 0 END) AS pass,
+                    SUM(CASE WHEN t.status='FAIL' THEN 1 ELSE 0 END) AS fail,
+                    SUM(CASE WHEN t.status IN ('PASS','FAIL') THEN 0 ELSE 1 END) AS other
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE r.target LIKE ? 
+            GROUP BY r.target,r.run_name, r.event_time
+             order by r.target,r.event_time desc limit  ? offset ?   ;"
+    target-patt limit offset))
+     
+
+(define (pgdb:get-count-data-stats-target-slice dbh target-patt)
+  (dbi:get-rows
+   dbh
+    "SELECT count(*)  from (SELECT  r.target, r.run_name,r.event_time, COUNT(*) AS total
+            FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id
+            WHERE r.target LIKE ?
+            GROUP BY r.target,r.run_name, r.event_time 
+          ) as x;" 
+    target-patt))
+
+(define  (pgdb:get-slice-cnt dbh target-patt)
+  (let* ((cnt-result (pgdb:get-count-data-stats-target-slice dbh target-patt))
+         ;(cnt-row (car (cnt-result)))
+         (cnt 0) 
+       )
+    (for-each
+     (lambda (row)
+      (set! cnt  (vector-ref row 0 ))) 
+     cnt-result)
+
+cnt))
+   
+
+(define (pgdb:get-target-types dbh)
+  (dbi:get-rows dbh "SELECT id,target_spec FROM ttype;"))
+ 
+ (define (pgdb:get-distict-target-slice dbh)
+  (dbi:get-rows dbh " select distinct on (split_part (target, '/', 1)) (split_part (target, '/', 1)) from runs;"))
+
+  (define (pgdb:get-distict-target-slice3 dbh)
+  (dbi:get-rows dbh " select distinct on (split_part (target, '/', 3)) (split_part (target, '/', 3)) from runs;"))
+;; 
+(define (pgdb:get-targets dbh target-patt)
+  (let ((ttypes (pgdb:get-target-types dbh)))
+    (map
+     (lambda (ttype-dat)
+       (let ((tt-id (vector-ref ttype-dat 0))
+	     (ttype (vector-ref ttype-dat 1)))
+	 (cons ttype
+	       (dbi:get-rows 
+		dbh
+		"SELECT DISTINCT target FROM runs WHERE target LIKE ? AND ttype_id=?;" target-patt tt-id))
+	 ))
+     ttypes)))
+
+(define (pgdb:get-targets-of-type dbh ttype-id target-patt)
+  (dbi:get-rows dbh "SELECT DISTINCT target FROM runs WHERE target LIKE ? AND ttype_id=?;" target-patt ttype-id))
+
+(define (pgdb:get-runs-by-target dbh targets run-patt)
+   (dbi:get-rows dbh "SELECT r.run_name, t.test_name, t.status, t.item_path, t.id, t.rundir, t.final_logf FROM runs as r INNER JOIN tests AS t ON t.run_id=r.id  
+                          WHERE t.state='COMPLETED' AND r.target like ? AND  r.run_name like ?;" targets run-patt)
+)
+
+(define (pgdb:get-test-by-id dbh id)
+  (dbi:get-rows dbh "SELECT t.test_name, t.item_path, t.rundir, t.final_logf FROM runs as r INNER JOIN tests AS t ON t.run_id=r.id  
+                          WHERE t.id = ?;" id)
+)
+
+;;======================================================================
+;;  V A R I O U S   D A T A   M A S S A G E   R O U T I N E S
+;;======================================================================
+
+;; probably want to move these to a different model file
+
+;; create a hash of hashes with keys extracted from all-parts
+;; using row-or-col to choose row or column
+;;   ht{row key}=>ht{col key}=>data
+;;
+;; fnum is the field number in the tuples to be split
+;;
+
+(define (pgdb:mk-pattern  dot type bp rel)
+  (let* ((typ (if (equal? type "all")
+               "%"
+                type))
+        (dotprocess (if (equal? dot "all")
+                      "%"
+                     dot))
+        (rel-num (if (equal? rel "")
+                      "%"
+                     rel))
+        (pattern  (conc "%/" bp "/" dotprocess "/" typ "_" rel-num)))
+pattern))
+
+(define (pgdb:coalesce-runs dbh runs all-parts row-or-col fnum)
+  (let* ((data  (make-hash-table)))
+    
+    (for-each
+     (lambda (run)
+       (let* ((target (vector-ref run fnum))
+	      (parts  (string-split target "/"))
+	      (first  (car parts))
+	      (rest   (string-intersperse (cdr parts) "/"))
+	      (coldat (hash-table-ref/default data first #f)))
+	 (if (not coldat)(let ((newht (make-hash-table)))
+			   (hash-table-set! data first newht)
+			   (set! coldat newht)))
+	 (hash-table-set! coldat rest run)))
+     runs)
+    data))
+
+
+(define (pgdb:coalesce-runs1 runs  )
+  (let* ((data  (make-hash-table)))
+    
+    (for-each
+     (lambda (run)
+       (let* ((target (vector-ref run 0))
+	      (parts  (string-split target "/"))
+	      (first  (car parts))
+	      (rest   (string-intersperse (cdr parts) "/"))
+	      (coldat (hash-table-ref/default data first #f)))
+	 (if (not coldat)(let ((newht (make-hash-table)))
+			   (hash-table-set! data first newht)
+			   (set! coldat newht)))
+	 (hash-table-set! coldat rest run)))
+     runs)
+    data))
+
+;; given ordered data hash return a-keys
+;;
+(define (pgdb:ordered-data->a-keys ordered-data)
+  (sort (hash-table-keys ordered-data) string>=?))
+
+;; given ordered data hash return b-keys
+;;
+(define (pgdb:ordered-data->b-keys ordered-data a-keys)
+  (delete-duplicates
+   (sort (apply
+	  append
+	  (map (lambda (sub-key)
+		 (let ((subdat (hash-table-ref ordered-data sub-key)))
+		   (hash-table-keys subdat)))
+	       a-keys))
+	 string>=?)))
+
+;; given ordered data hash return a-keys
+;;
+(define (pgdb:ordered-data->a-keys ordered-data)
+  (sort (hash-table-keys ordered-data) string>=?))
+
+;; given ordered data hash return b-keys
+;;
+(define (pgdb:ordered-data->b-keys ordered-data a-keys)
+  (delete-duplicates
+   (sort (apply
+	  append
+	  (map (lambda (sub-key)
+		 (let ((subdat (hash-table-ref ordered-data sub-key)))
+		   (hash-table-keys subdat)))
+	       a-keys))
+	 string>=?)))
+
+(define (pgdb:coalesce-runs-by-slice runs slice)
+  (let* ((data  (make-hash-table)))
+      (for-each
+     (lambda (run)
+       (let* ((target (vector-ref run 0))
+              (run-name (vector-ref run 1))    
+	      (parts  (string-split target "/"))
+	      (first  (car parts))
+	      (rest   (string-intersperse (cdr parts) "/"))
+	      (coldat (hash-table-ref/default data rest #f)))
+	 (if (not coldat)(let ((newht (make-hash-table)))
+			   (hash-table-set! data rest newht)
+			   (set! coldat newht)))
+	 (hash-table-set! coldat run-name run)))
+     runs)
+    data))
+
+
+(define (pgdb:runs-to-hash runs )
+  (let* ((data  (make-hash-table)))
+    (for-each
+     (lambda (run)
+       (let* ((run-name (vector-ref run 0))
+	      (test (conc (vector-ref run 1) ":" (vector-ref run 3)))
+	      (coldat (hash-table-ref/default data run-name #f)))
+	 (if (not coldat)(let ((newht (make-hash-table)))
+			   (hash-table-set! data run-name newht)
+			   (set! coldat newht)))
+	 (hash-table-set! coldat test run)))
+     runs)
+    data))
+
+(define (pgdb:get-history-hash runs)
+  (let* ((data  (make-hash-table)))
+     (for-each
+     (lambda (run)
+       (let* ((run-name (vector-ref run 0)))
+	 (hash-table-set! data run-name run)))
+     runs)
+    data))
+
+(define (pgdb:get-pg-lst tab2-pages)
+    (let loop ((i 1)
+             (lst `()))
+                       (cond
+                        ((> i tab2-pages )
+                        lst) 
+                      (else 
+		  	(loop (+ i 1) (append   lst (list i)))))))
+

DELETED records-vs-vectors-vs-coops.scm
Index: records-vs-vectors-vs-coops.scm
==================================================================
--- records-vs-vectors-vs-coops.scm
+++ /dev/null
@@ -1,110 +0,0 @@
-;;  Copyright 2006-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/>.
-
-;; (include "vg.scm")
-
-;; (declare (uses vg))
-
-(use foof-loop defstruct coops)
-
-(defstruct obj     type fill-color angle)
-
-(define (make-vg:obj)(make-vector 3))
-(define-inline (vg:obj-get-type         vec)    (vector-ref  vec 0))
-(define-inline (vg:obj-get-fill-color   vec)    (vector-ref  vec 1))
-(define-inline (vg:obj-get-angle        vec)    (vector-ref  vec 2))
-(define-inline (vg:obj-set-type!        vec val)(vector-set! vec 0 val))
-(define-inline (vg:obj-set-fill-color!  vec val)(vector-set! vec 1 val))
-(define-inline (vg:obj-set-angle!       vec val)(vector-set! vec 2 val))
-
-(use simple-exceptions)
-(define vgs:obj-exn (make-exception "wrong record type, expected vgs:obj." 'assert))
-(define (make-vgs:obj)(let ((v (make-vector 4)))(vector-set! v 0 'vgs:obj) v))
-(define-inline (vgs:obj-type             vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 1)(raise (vgs:obj-exn 'vgs:obj-type 'xpr))))
-(define-inline (vgs:obj-fill-color       vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 2)(raise (vgs:obj-exn 'vgs:obj-fill-color 'xpr))))
-(define-inline (vgs:obj-angle            vec)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-ref  vec 3)(raise (vgs:obj-exn 'vgs:obj-angle 'xpr))))
-(define-inline (vgs:obj-type-set!        vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 1 val)(raise (vgs:obj-exn 'type))))
-(define-inline (vgs:obj-fill-color-set!  vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 2 val)(raise (vgs:obj-exn 'fill-color))))
-(define-inline (vgs:obj-angle-set!       vec val)(if (eq? (vector-ref vec 0) 'vgs:obj)(vector-set! vec 3 val)(raise (vgs:obj-exn 'angle))))
-
-(define-class <vgc> ()
-  ((type)
-   (fill-color)
-   (angle)))
-
-
-;; first use raw vectors
-(print "Using vectors")
-(time
- (loop ((for r (up-from 0 (to 255))))
-       (loop ((for g (up-from 0 (to 255))))
-	     (loop ((for b (up-from 0 (to 255))))
-		   (let ((obj (make-vg:obj)))
-		     (vg:obj-set-type! obj 'abc)
-		     (vg:obj-set-fill-color! obj "green")
-		     (vg:obj-set-angle! obj 135)
-		     (let ((a (vg:obj-get-type obj))
-			   (b (vg:obj-get-fill-color obj))
-			   (c (vg:obj-get-angle obj)))
-		       obj))))))
-
-;; first use raw vectors with safe mode
-(print "Using vectors (safe mode)")
-(time
- (loop ((for r (up-from 0 (to 255))))
-       (loop ((for g (up-from 0 (to 255))))
-	     (loop ((for b (up-from 0 (to 255))))
-		   (let ((obj (make-vgs:obj)))
-		     ;; (badobj (make-vector 20)))
-		     (vgs:obj-type-set! obj 'abc)
-		     (vgs:obj-fill-color-set! obj "green")
-		     (vgs:obj-angle-set! obj 135)
-		     (let ((a (vgs:obj-type obj))
-			   (b (vgs:obj-fill-color obj))
-			   (c (vgs:obj-angle obj)))
-		       obj))))))
-
-;; first use defstruct
-(print "Using defstruct")
-(time
- (loop ((for r (up-from 0 (to 255))))
-       (loop ((for g (up-from 0 (to 255))))
-	     (loop ((for b (up-from 0 (to 255))))
-		   (let ((obj (make-obj)))
-		     (obj-type-set! obj 'abc)
-		     (obj-fill-color-set! obj "green")
-		     (obj-angle-set! obj 135)
-		     (let ((a (obj-type obj))
-			   (b (obj-fill-color obj))
-			   (c (obj-angle obj)))
-		       obj))))))
-		   
-
-;; first use defstruct
-(print "Using coops")
-(time
- (loop ((for r (up-from 0 (to 255))))
-       (loop ((for g (up-from 0 (to 255))))
-	     (loop ((for b (up-from 0 (to 255))))
-		   (let ((obj (make <vgc>)))
-		     (set! (slot-value obj 'type) 'abc)
-		     (set! (slot-value obj 'fill-color) "green")
-		     (set! (slot-value obj 'angle) 135)
-		     (let ((a (slot-value obj 'type))
-			   (b (slot-value obj 'fill-color))
-			   (c (slot-value obj 'angle)))
-		       obj))))))

Index: rmt-inc.scm
==================================================================
--- rmt-inc.scm
+++ rmt-inc.scm
@@ -332,11 +332,11 @@
 	 (resdat         (if (not (and read-only qry-is-write))
 			     (let ((v (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
 			       (handle-exceptions ;; there has been a long history of receiving strange errors from values returned by the client when things go wrong..
 				exn               ;;  This is an attempt to detect that situation and recover gracefully
 				(begin
-				  (debug:print0 *default-log-port* "ERROR: bad data from server " v " message: "  ((condition-property-accessor 'exn 'message) exn))
+				  (debug:print 0 *default-log-port* "ERROR: bad data from server " v " message: "  ((condition-property-accessor 'exn 'message) exn))
 				  (vector #t '())) ;; should always get a vector but if something goes wrong return a dummy
 				(if (and (vector? v)
 					 (> (vector-length v) 1))
 				    (let ((newvec (vector (vector-ref v 0)(vector-ref v 1))))
 				      newvec)           ;; by copying the vector while inside the error handler we should force the detection of a corrupted record
@@ -515,11 +515,11 @@
 	#f)))
 
 (define (rmt:test-get-rundir-from-test-id run-id test-id)
   (rmt:send-receive 'test-get-rundir-from-test-id run-id (list run-id test-id)))
 
-(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
+#;(define (rmt:open-test-db-by-test-id run-id test-id #!key (work-area #f))
   (let* ((test-path (if (string? work-area)
 			work-area
 			(rmt:test-get-rundir-from-test-id run-id test-id))))
     (debug:print 3 *default-log-port* "TEST PATH: " test-path)
     (open-test-db test-path)))
@@ -921,10 +921,68 @@
   (rmt:send-receive 'test-set-archive-block-id run-id (list run-id test-id archive-block-id)))
 
 (define (rmt:test-get-archive-block-info archive-block-id)
   (rmt:send-receive 'test-get-archive-block-info #f (list archive-block-id)))
 
-(set-functions rmt:send-receive                       remote-server-url-set!
+#;(set-functions rmt:send-receive                       remote-server-url-set!
 	       http-transport:close-connections	      remote-conndat-set!
 	       debug:print                            debug:print-info
 	       remote-ro-mode                         remote-ro-mode-set!
 	       remote-ro-mode-checked-set!            remote-ro-mode-checked)
+
+(define (rmtmod:calc-ro-mode runremote *toppath*)
+  (if (and runremote
+	   (remote-ro-mode-checked runremote))
+      (remote-ro-mode runremote)
+      (let* ((dbfile  (conc *toppath* "/megatest.db"))
+	     (ro-mode (not (file-write-access? dbfile)))) ;; TODO: use dbstruct or runremote to figure this out in future
+	(if runremote
+	    (begin
+	      (remote-ro-mode-set! runremote ro-mode)
+	      (remote-ro-mode-checked-set! runremote #t)
+	      ro-mode)
+	    ro-mode))))
+
+(define (extras-readonly-mode rmt-mutex log-port cmd params)
+  (mutex-unlock! rmt-mutex)
+  (debug:print-info 12 log-port "rmt:send-receive, case 3")
+  (debug:print 0 log-port "WARNING: write transaction requested on a readonly area.  cmd="cmd" params="params)
+  #f)
+
+(define (extras-transport-failed *default-log-port* *rmt-mutex* attemptnum runremote cmd rid params)
+  (debug:print 0 *default-log-port* "WARNING: communication failed. Trying again, try num: " attemptnum)
+  (mutex-lock! *rmt-mutex*)
+  (remote-conndat-set!    runremote #f)
+  (http-transport:close-connections area-dat: runremote)
+  (remote-server-url-set! runremote #f)
+  (mutex-unlock! *rmt-mutex*)
+  (debug:print-info 12 *default-log-port* "rmt:send-receive, case  9.1")
+  (rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
+  
+(define (extras-transport-succeded *default-log-port* *rmt-mutex* attemptnum runremote res params rid cmd)
+  (if (and (vector? res)
+	   (eq? (vector-length res) 2)
+	   (eq? (vector-ref res 1) 'overloaded)) ;; since we are
+						 ;; looking at the
+						 ;; data to carry the
+						 ;; error we'll use a
+						 ;; fairly obtuse
+						 ;; combo to minimise
+						 ;; the chances of
+						 ;; some sort of
+						 ;; collision.  this
+						 ;; is the case where
+						 ;; the returned data
+						 ;; is bad or the
+						 ;; server is
+						 ;; overloaded and we
+						 ;; want to ease off
+						 ;; the queries
+      (let ((wait-delay (+ attemptnum (* attemptnum 10))))
+	(debug:print 0 *default-log-port* "WARNING: server is overloaded. Delaying " wait-delay " seconds and trying call again.")
+	(mutex-lock! *rmt-mutex*)
+	(http-transport:close-connections area-dat: runremote)
+	(set! *runremote* #f) ;; force starting over
+	(mutex-unlock! *rmt-mutex*)
+	(thread-sleep! wait-delay)
+	(rmt:send-receive cmd rid params attemptnum: (+ attemptnum 1)))
+      res)) ;; All good, return res

Index: runs-inc.scm
==================================================================
--- runs-inc.scm
+++ runs-inc.scm
@@ -364,11 +364,12 @@
          (waitors-upon       (make-hash-table)) ;; given a test, return list of tests waiting upon this test.
 	 (task-key           (conc (hash-table->alist flags) " " (get-host-name) " " (current-process-id)))
 	 ;; (tdbdat             (tasks:open-db))
 	 (config-reruns      (let ((x (configf:lookup *configdat* "setup" "reruns")))
 			       (if x (string->number x) #f)))
-	 (allowed-tests      #f))
+	 (allowed-tests      #f)
+	 (runconf            #f))
 
     ;; check if readonly
     (when readonly-mode
       (debug:print-error 0 *default-log-port* "megatest.db is readonly.  Cannot proceed.")
       (exit 1))
@@ -2557,11 +2558,11 @@
      (hash-table-keys test-names))))
 
 ;; This could probably be refactored into one complex query ...
 ;; NOT PORTED - DO NOT USE YET
 ;;
-(define (runs:rollup-run keys runname user keyvals)
+#;(define (runs:rollup-run keys runname user keyvals)
   (debug:print 4 *default-log-port* "runs:rollup-run, keys: " keys " -runname " runname " user: " user)
   (let* ((db              #f)
 	 ;; register run operates on the main db
 	 (new-run-id      (rmt:register-run keyvals runname "new" "n/a" user (args:get-arg "-contour")))
 	 (prev-tests      (rmt:get-matching-previous-test-run-records new-run-id "%" "%"))

Index: tasks-inc.scm
==================================================================
--- tasks-inc.scm
+++ tasks-inc.scm
@@ -99,11 +99,11 @@
 	      (mdb          (cond ;; what the hek is *toppath* doing here?
 			     ((and (string? *toppath*)(file-write-access? *toppath*))
 			      (sqlite3:open-database dbfile))
 			     ((file-read-access? dbpath)    (sqlite3:open-database dbfile))
 			     (else (sqlite3:open-database ":memory:")))) ;; (never-give-up-open-db dbpath))
-	      (handler      (make-busy-timeout 36000)))
+	      (handler      (sqlite3:make-busy-timeout 36000)))
 	 (if (and exists
 		  (not write-access))
 	     (set! *db-write-access* write-access)) ;; only unset so other db's also can use this control
 	 (sqlite3:set-busy-handler! mdb handler)
 	 (db:set-sync mdb) ;; (sqlite3:execute mdb (conc "PRAGMA synchronous = 0;"))
@@ -265,11 +265,11 @@
      "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;"
      (car (user-information (current-user-id))))
     res))
 
 ;; 
-(define (tasks:start-monitor db mdb)
+#;(define (tasks:start-monitor db mdb)
   (if (> (tasks:get-num-alive-monitors mdb) 2) ;; have two running, no need for more
       (debug:print-info 1 *default-log-port* "Not starting monitor, already have more than two running")
       (let* ((megatestdb     (conc *toppath* "/megatest.db"))
 	     (monitordbf     (conc (db:dbfile-path #f) "/monitor.db"))
 	     (last-db-update 0)) ;; (file-modification-time megatestdb)))
@@ -429,23 +429,23 @@
   (db:with-db
    dbstruct #f #t
    (lambda (db)
      (sqlite3:execute db (conc "DELETE FROM tasks_queue WHERE id IN (" task-ids ");")))))
 
-(define (tasks:process-queue dbstruct)
+#;(define (tasks:process-queue dbstruct)
   (let* ((task   (tasks:snag-a-task dbstruct))
 	 (action (if task (tasks:task-get-action task) #f)))
     (if action (print "tasks:process-queue task: " task))
     (if action
 	(case (string->symbol action)
 	  ((run)       (tasks:start-run     dbstruct task))
 	  ((remove)    (tasks:remove-runs   dbstruct task))
 	  ((lock)      (tasks:lock-runs     dbstruct task))
 	  ;; ((monitor)   (tasks:start-monitor db task))
-	  ((rollup)    (tasks:rollup-runs   dbstruct task))
+	  #;((rollup)    (tasks:rollup-runs   dbstruct task))
 	  ((updatemeta)(tasks:update-meta   dbstruct task))
-	  ((kill)      (tasks:kill-monitors dbstruct task))))))
+	  #;((kill)      (tasks:kill-monitors dbstruct task))))))
 
 (define (tasks:tasks->text tasks)
   (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~10a"))
     (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "params") "\n"
 	  (string-intersperse 
@@ -455,11 +455,11 @@
 			  (tasks:task-get-action task)
 			  (tasks:task-get-owner  task)
 			  (tasks:task-get-state  task)
 			  (tasks:task-get-target task)
 			  (tasks:task-get-name   task)
-			  (tasks:task-get-test   task)
+			  (tasks:task-get-testpatt task)
 			  ;; (tasks:task-get-item   task)
 			  (tasks:task-get-params task)))
 		tasks) "\n"))))
    
 (define (tasks:set-state dbstruct task-id state)

Index: tests-inc.scm
==================================================================
--- tests-inc.scm
+++ tests-inc.scm
@@ -1908,11 +1908,11 @@
 	 (uname    (get-uname "-srvpio"))
 	 (hostname (get-host-name)))
     (tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)))
     
 ;; (define (tests:set-partial-meta-info test-id run-id minutes work-area)
-(define (tests:set-partial-meta-info test-id run-id minutes work-area remtries)
+#;(define (tests:set-partial-meta-info test-id run-id minutes work-area remtries)
   (let* ((cpuload  (get-cpu-load))
 	 (diskfree (get-df (current-directory)))
 	 (remtries 10))
     (handle-exceptions
      exn

Index: vg-inc.scm
==================================================================
--- vg-inc.scm
+++ vg-inc.scm
@@ -555,11 +555,11 @@
 	;;     (begin
 	;; 	(canvas-foreground-set! cnv fill-color)
 	;; 	(canvas-box! cnv llx ulx lly uly))) ;; docs are all over the place on this one.;; w h)
 	  (if line-color
 	      (canvas-foreground-set! cnv line-color)
-	      (if fill-color
+	      #;(if fill-color
 		  (canvas-foreground-set! cnv prev-foreground-color)))
 	  (canvas-line! cnv llx ulx lly uly)
 	  (canvas-foreground-set! cnv prev-foreground-color)
 	  (if text 
 	      (let* ((prev-font    (canvas-font cnv))