Megatest

(include "task_records.scm")
(include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")

(dbfile:db-init-proc db:initialize-main-db)

;; globals to dashboard module
(define *updaters-running* #f)
(define *updaters-thread*  #f)

(define help (conc 
	      "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest version " megatest-version 
              " license GPL, Copyright (C) Matt Welland 2012-2017

Usage: dashboard [options]
  -h                    : this help
  -test run-id test-id  : open a test control panel on this test

                                         (let ((val (hash-table-ref/default (dboard:tabdat-searchpatts tabdat) key #f)))
                                           (if val (set! res (cons (list key val) res))))))
                                   dbkeys)
                         res))))
       fres))))

(define (dashboard:runs-tab-updater commondat tab-num)
  (debug:catch-and-dump 
   (lambda ()
;;  (debug:catch-and-dump 
;;   (lambda ()
     (let* ((tabdat (dboard:common-get-tabdat commondat tab-num: tab-num))
	    (dbkeys (dboard:tabdat-dbkeys tabdat)))
       (dashboard:do-update-rundat tabdat)
       (let ((uidat (dboard:commondat-uidat commondat)))
	 (update-buttons tabdat uidat (dboard:tabdat-numruns tabdat) (dboard:tabdat-num-tests tabdat)))
       ))
   "dashboard:runs-tab-updater"))
;;   "dashboard:runs-tab-updater"))

;;======================================================================
;; The heavy lifting starts here
;;======================================================================

(stop-the-train)

	 tab-num: 0)
        ;; may not want this alive (manually merged it from v1.66)
	;; (dboard:commondat-add-updater 
	;;  commondat 
	;;  (lambda ()
	   ;;  (dashboard:runs-tab-updater commondat 1))
	;; tab-num: 2)
        
	(iup:callback-set! *tim*
			   "ACTION_CB"
			   (lambda (time-obj)
			     (let ((update-is-running #f))
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
			     (set! update-is-running (dboard:commondat-updating commondat))
			     (if (not update-is-running)
			     (if (not *updaters-thread*)
			     (dboard:commondat-updating-set! commondat #t))
			     (mutex-unlock! (dboard:commondat-update-mutex commondat))
			     (if (not update-is-running) ;; we know that the update was not running and we now have a lock on doing an update
			     (begin
				   ;; (debug:print-info 0 *default-log-port* "Updater started...")
				   (set! *updaters-thread*
					 (make-thread
					  (lambda ()
			     (dboard:common-run-curr-updaters commondat) ;; (dashboard:run-update commondat)
			     (mutex-lock! (dboard:commondat-update-mutex commondat))
					    (dboard:common-run-curr-updaters commondat))))
				   (thread-start! *updaters-thread*))
			     (dboard:commondat-updating-set! commondat #f)
			     (mutex-unlock! (dboard:commondat-update-mutex commondat)))
				   ))
			     1))))
      ;; (debug:print 0 *default-log-port* "Starting updaters")
      (let ((th1 (make-thread (lambda ()
				(thread-sleep! 1)
				 (begin
				   (debug:print-info 0 *default-log-port* "Updater restarted...")
				   (thread-resume! *updaters-thread*)))
			     (thread-sleep! 0.25)
				(dboard:common-run-curr-updaters commondat 0) ;; force update of summary tab 
				) "update buttons once"))
			     (if (eq? (thread-state *updaters-thread*) 'running)
	    (th2 (make-thread iup:main-loop "Main loop")))
        ;; (print "Starting main loop")
	(thread-start! th2)
	(thread-join! th2)
      )
    )
  )
				 (begin
				   (debug:print-info 0 *default-log-port* "Updater suspended...")
				   (thread-suspend! *updaters-thread*))
				 (begin
				   (set! *updaters-thread* #f)
				   ;; (debug:print-info 0 *default-log-port* "Updater done...")
				   ))
			     1))))
        (iup:main-loop)
      )))
)

(define last-copy-time 0)


;; Sync to tmp only if in read-only mode.

(define (sync-db-to-tmp tabdat)