Megatest

     z3)

(import stml2
	)

(module commonmod
	(
	 db:testmeta-get-owner 
	 db:testmeta-get-author
	 db:testmeta-get-description
	 db:testmeta-get-reviewed
	 db:testmeta-get-tags
	 make-db:testmeta
	 
	 common:sparse-list-generate-index
	 common:lazy-sqlite-db-modification-time
	 make-sparse-array
	 sparse-array-set!
	 sparse-array-ref
	 keys->valslots
	 item-list->path
	 common:human-time
	 number-of-processes-running

	 tests:match
	 patt-list-match
	 common:pkts-spec

	 sdb:qry
	 seconds->work-week/day-time
	 seconds->work-week/day

	 tdb:step-get-comment
	 seconds->hr-min-sec
	 any->number
	 tdb:step-get-logfile
	 tdb:step-get-event_time
	 tdb:step-get-status

	stml2
	megatestmod
	tasksmod
	runsmod
	testsmod
	)

(include "common_records.scm")
;; (include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")
(include "vg_records.scm")

		 0))

(if (args:get-arg "-mode")
    (let* ((mode (string->symbol (args:get-arg "-mode"))))
      (rmt:transport-mode mode)))
;;  (rmt:transport-mode 'tcp))

;; (if (args:get-arg "-test") ;; need to use tcp for test control panel
;;     (rmt:transport-mode 'tcp))

;; RA => Might require revert for filters 
;; create a watch dog to move changes from lt/.db/*.db to megatest.db
;;
;;;(if (file-write-access? (conc *toppath* "/megatest.db"))
;;(debug:print-info 13 *default-log-port* "Before common:watchdog spawn")

                       (begin
			 (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) #f tmpdb mtdb)))
		   (hash-table-set! sync-durations (conc srcfile ".db") (- (current-milliseconds) start-time)))
		 (debug:print-info 2 *default-log-port* "skipping delta sync. " srcfile " is up to date"))))
	 dbfiles))
    data-synced))

;; ;; Sync all changed db's
;; ;;
;; (define (db:tmp->megatest.db-sync dbstruct run-id last-update)
;;   (let* ((subdbs (hash-table-values (dbr:dbstruct-subdbs dbstruct)))
;; 	 (res    '()))
;;     (for-each
;;      (lambda (subdb)
;;        (let* ((mtdb   (dbr:subdb-mtdbdat subdb))
;; 	      (tmpdb  (db:get-subdb dbstruct run-id))
;; 	      (refndb (dbr:subdb-refndb subdb))
;; 	      (newres (db:sync-tables (db:sync-all-tables-list (db:get-keys dbstruct)) last-update tmpdb refndb mtdb)))
;; 	 ;; (stack-push! (dbr:subdb-dbstack subdb) tmpdb)
;; 	 ;; BUG: verify this is really needed
;; 	 (dbfile:add-dbdat dbstruct run-id tmpdb)
;; 	 (set! res (cons newres res))))
;;      subdbs)
;;     res))

;;;; run-ids
;;    if #f use *db-local-sync* : or 'local-sync-flags
;;    if #t use timestamps      : or 'timestamps
;;
;;  NB// no-sync-db is the db handle, not a flag!
;;
;; (define (db:sync-to-megatest.db dbstruct #!key (no-sync-db #f)) 
;;   (let* ((start-time         (current-seconds))
;; 	 (last-full-update   (if no-sync-db
;; 				 (db:no-sync-get/default no-sync-db "LAST_FULL_UPDATE" 0)
;; 				 0))
;; 	 (full-sync-needed   (> (- start-time last-full-update) 3600)) ;; every hour do a full sync
;; 	 (last-update        (if full-sync-needed

;; 				 0
;; 				 (if no-sync-db
;; 				     (db:no-sync-get/default no-sync-db "LAST_UPDATE" 0)
;; 				     0))) ;; (or (db:get-var dbstruct "LAST_UPDATE") 0))
;; 	 (sync-needed        (> (- start-time last-update) 6))
;; 	 (res                (if (or sync-needed ;; don't sync if a sync already occurred in the past 6 seconds
;; 				     full-sync-needed)
;; 				 (begin
;; 				   (if no-sync-db
;; 				       (begin
;; 					 (if full-sync-needed (db:no-sync-set no-sync-db "LAST_FULL_UPDATE" start-time))
;; 					 (db:no-sync-set no-sync-db "LAST_UPDATE" start-time)))
;; 				   (db:tmp->megatest.db-sync dbstruct run-id last-update))
;; 				 0))
;; 	 (sync-time           (- (current-seconds) start-time)))
;;       (debug:print-info 3 *default-log-port* "Sync of newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;;       (if (common:low-noise-print 30 "sync new to old")
;;           (if sync-needed
;;               (debug:print-info 0 *default-log-port* "Sync of " res " records from newdb to olddb completed in " sync-time " seconds pid="(current-process-id))
;;               (debug:print-info 0 *default-log-port* "No sync needed, last updated " (- start-time last-update) " seconds ago")))
;;       res))


(define (db:initialize-main-db db #!key (launch-setup #f))
  (when (not *configinfo*)
    (if launch-setup
	(launch-setup) ;; added because Elena was getting stack dump because *configinfo* below was #f.
	(assert #f "db:initialize-main-db called and needs launch:setup but was not given it")))

  ;;
  (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))
    (if (common:file-exists? debugcontrolf)
	(load debugcontrolf)))

  ;; usage logging, careful with this, it is not designed to deal with all real world challenges!
  ;;
  (if (and (string? *usage-log-file*)
           (file-write-access? *usage-log-file*))
      (with-output-to-file
          *usage-log-file*
	(lambda ()
          (print (if *usage-use-seconds*
		     (current-seconds)
		     (time->string

(declare (uses mtmod))
(declare (uses tcp-transportmod))
(declare (uses apimod))
(declare (uses servermod))

(module rmtmod
	(
	 rmt:read-test-data
	 rmt:get-targets
	 rmt:get-run-stats
	 rmt:get-key-vals
	 rmt:test-data-rollup
	 rmt:import-sexpr
	 rmt:read-test-data-varpatt
	 rmt:get-run-status
	 rmt:set-run-status

	 rmtmod:send-receive

(declare (uses megatestmod))
(declare (uses tasksmod))

(use srfi-69)

(module subrunmod
	(
	 subrun:launch-dashboard 
	 subrun:get-runarea
	 subrun:set-state-status
	 subrun:kill-subrun
	 subrun:get-log-path
	 subrun:remove-subrun
	 subrun:subrun-removed?
	 subrun:subrun-test-initialized?
	 subrun:launch-cmd

	 tests:get-waitons

	 tests:get-test-path-from-environment
	 common:exit-on-version-changed
	 task:get-run-times
	 task:get-test-times
	 tasks:sync-to-postgres
	 tests:get-full-data
	 )

(import scheme)
(cond-expand
 (chicken-4
  
  (import chicken

(use srfi-69)

(module testsmod
	(
	 tests:summarize-items
	 tests:filter-non-runnable
	 tests:sort-by-priority-and-waiton
	 tests:lazy-dot
	 
	 tests:summarize-test
	 tests:save-final-status
	 tests:update-central-meta-info
	 tests:set-full-meta-info
	 tests:get-compressed-steps
	 tests:create-html-summary
	 tests:create-html-summary