Megatest

			      (megatestdbpath (conc *toppath* "/megatest.db"))
			      (modtime        (max (file-modification-time megatestdbpath)
						   (file-modification-time monitordbpath))))
			 ;; do stuff here when the db is updated by some other process
			 (if (> modtime lastmodtime)
			     (let ((tlst (tasks:get-tasks tdb '() '()))
				   (mlst (tasks:get-monitors tdb)))
			       ;; (set! tasksdat tlst)
			       ;; (set! monitorsdat mlst)
			       ;; (iup:attribute-set! monitors "VALUE" (tasks:monitors->text-table mlst))
			       ;; (iup:attribute-set! actions  "VALUE" (tasks:tasks->text tlst))
			       ;; (tasks:process-queue db tdb)
			       (set! lastmodtime (max (file-modification-time megatestdbpath)
			         		      (file-modification-time monitordbpath)))
			       ;; (tasks:reset-stuck-tasks tdb)))
			       ))
			 ;; stuff to do every 10 seconds
			 (if (> (current-seconds) next-touch)
			     (begin
			       ;; (tasks:process-queue db tdb monitordbpath)
			       ;; (tasks:monitors-update tdb)
			       ;; (tasks:reset-stuck-tasks tdb)
			       (set! monitorsdat (tasks:get-monitors tdb)
			       )
			       (set! next-touch (+ (current-seconds) 10))
			       )))))
	 (topdialog  #f))
    (set! topdialog (iup:vbox ;; iup:dialog 
		     #:close_cb (lambda (a)(exit))
		     #:title "Run Controls"
		     (iup:vbox

    (sqlite3:set-busy-handler! db handler)
    (if (not dbexists)
	(begin
	  (sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
	  (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
    db))

(define (db:log-local-event . loglst)

  (let ((logline (apply conc loglst))
	(pwd     (current-directory))
	(cmdline (string-intersperse (argv) " "))
	(pid     (current-process-id)))
    (db:log-event logline pwd cmdline pid)))

(define (db:log-event logline pwd cmdline pid)
  (let ((db (open-logging-db)))
    (sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory)(string-intersperse (argv) " ")(current-process-id))
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;;   put deltas into an assoc list with version numbers

(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile)
  (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name)
  (let* ((tdb       (db:open-test-db-by-test-id db test-id))
	 (state     (items:check-valid-items "state" state-in))
	 (status    (items:check-valid-items "status" status-in)))
    (if (or (not state)(not status))
	(debug:print 3 "WARNING: Invalid " (if status "status" "state")
		     " value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
    (if tdb
	(begin
	  (sqlite3:execute 
	   tdb
	   "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
	   test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile ""))

(define sub  (make-socket 'sub))
(define push (make-socket 'push))
(socket-option-set! sub 'subscribe cname)
(connect-socket sub "tcp://localhost:5563")
(connect-socket push "tcp://localhost:5564")

(define (dbaccess cname cmd var val #!key (numtries 20))
  (let* ((msg (conc cname ":" cmd ":" (if val (conc var " " val) var)))
	 (res #f)
	 (mtx1 (make-mutex))
	 (do-access (lambda ()
		      (print "Sending msg: " msg)
		      (send-message push msg)
		      (print "Message " msg " sent")
		      (print "Client " cname " waiting for response to " msg)
		      (print "Client " cname " received address " (receive-message* sub))
		      (mutex-lock! mtx1)
		      (set! res (receive-message* sub))
		      (mutex-unlock! mtx1))))
    (let ((th1 (make-thread do-access "do access"))
	  (th2 (make-thread (lambda ()
			      (let ((result #f))
				(mutex-lock! mtx1)
				(set! result res)
				(mutex-unlock! mtx1)
				(thread-sleep! 5)
				(if (not result)
				    (if (> numtries 0)
					(begin
					  (print "WARNING: access timed out for " cname ", trying again. Trys remaining=" numtries)
					  (dbaccess cname cmd var val numtries: (- numtries 1)))
					(begin
					  (print "ERROR: dbaccess timed out. Exiting")
					  (exit)))))
			      "timeout thread"))))
      (thread-start! th1)
      (thread-start! th2)
      (thread-join! th1)
      res)))

;; pub/sub with envelope address
;; Note that if you don't insert a sleep, the server will crash with SIGPIPE as soon
;; as a client disconnects.  Also a remaining client may receive tons of
;; messages afterward.

(use zmq srfi-18 sqlite3)

(define pub (make-socket 'pub))
(define pull (make-socket 'pull))
(define cname "server")
(define total-db-accesses 0)
(define start-time (current-seconds))

(bind-socket pub "tcp://*:6563")
(bind-socket pull "tcp://*:6564")

(define (open-db)
  (let* ((dbpath    "mockup.db")
	 (dbexists  (file-exists? dbpath))
	 (db        (open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout 10)))
    (set-busy-handler! db handler)

(use posix)
(randomize (inexact->exact (current-seconds)))

(define low (string->number (cadr (argv))))
(define hi  (string->number (caddr (argv))))

(print (+ low (random (- hi low))))

#!/bin/bash

rm -f mockup.db

echo Compiling mockupserver.scm and mockupclient.scm
csc random.scm
csc mockupserver.scm
csc mockupclient.scm

echo Starting server
./mockupserver &

sleep 1

echo Starting clients
for i in a b c d e; # f g h i j k l m n o p q s t u v w x y z; 
  do
  for k in a b;
    do
    for j in 0 1 2 3 4 5 6 7 8 9;
      do
      waittime=`./random 0 60`
      runtime=`./random 5 120`
      echo "Starting client $i$k$j with waittime $waittime and runtime $runtime" 
      (sleep $waittime;./mockupclient $i$k$j $runtime) &
    done
  done
done

wait