Megatest

(define *toptest-paths*     (make-hash-table)) ;; cache toptest path settings here
(define *test-paths*        (make-hash-table)) ;; cache test-id to test run paths here
(define *test-ids*          (make-hash-table)) ;; cache run-id, testname, and item-path => test-id
(define *test-info*         (make-hash-table)) ;; cache the test info records, update the state, status, run_duration etc. from testdat.db

(define *run-info-cache*    (make-hash-table)) ;; run info is stable, no need to reget

;; Debugging stuff
(define *verbosity*         1)
(define *logging*           #f)

;; Awful. Please FIXME
(define *env-vars-by-run-id* (make-hash-table))
(define *current-run-name*   #f)

(define (common:clear-caches)
  (set! *target*             (make-hash-table))
  (set! *keys*               (make-hash-table))

    (debug:print-info 11 "db:initialize END")
    ))

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;;======================================================================
;; T E S T   S P E C I F I C   D B 
;;======================================================================

;; Create the sqlite db for the individual test(s)
(define (open-test-db testpath) 
  (debug:print-info 11 "open-test-db " testpath)
  (if (and testpath 
	   (directory? testpath)
	   (file-read-access? testpath))
      (let* ((dbpath    (conc testpath "/testdat.db"))

    (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))

;;======================================================================
;; L O G G I N G    D B 
;;======================================================================

(define (open-logging-db) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let* ((dbpath    (conc (if *toppath* (conc *toppath* "/") "") "logging.db")) ;; fname)
	 (dbexists  (file-exists? dbpath))
	 (db        (sqlite3:open-database dbpath)) ;; (never-give-up-open-db dbpath))
	 (handler   (make-busy-timeout (if (args:get-arg "-override-timeout")
					   (string->number (args:get-arg "-override-timeout"))
					   36000)))) ;; 136000)))
    (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);")
	  (sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
    db))

(define (db:log-event . loglst)
  (let ((db      (open-logging-db))
	(logline (apply conc loglst)))
    (sqlite3:execute db "INSERT INTO log (logline) VALUES (?);" logline)
    (sqlite3:finalize! db)
    logline))

;;======================================================================
;; TODO:
;;   put deltas into an assoc list with version numbers
;;   apply all from last to current
;;======================================================================
(define (patch-db db)

  -env2file fname         : write the environment to fname.csh and fname.sh
  -setvars VAR1=val1,VAR2=val2 : Add environment variables to a run NB// these are
                                 overwritten by values set in config files.
  -server -|hostname      : start the server (reduces contention on megatest.db), use
                            - to automatically figure out hostname
  -list-servers            : list the servers 
  -repl                   : start a repl (useful for extending megatest)
  -debug N                : increase verbosity to N. (try 10 for lots of noise)
  -logging                : turn on logging all debug output to logging.db

Spreadsheet generation
  -extract-ods fname.ods  : extract an open document spreadsheet from the database
  -pathmod path           : insert path, i.e. path/runame/itempath/logfile.html
                            will clear the field if no rundir/testname/itempath/logfile
                            if it contains forward slashes the path will be converted
                            to windows style

			"-rollup"
			"-update-meta"
			"-gen-megatest-area"

			"-logging"
			"-v" ;; verbose 2, more than normal (normal is 1)
			"-q" ;; quiet 0, errors/warnings only
			"-logging"
		       )
		 args:arg-hash
		 0))

(if (args:get-arg "-h")
    (begin
      (print help)

      ;; (debug:print 0 "    old: " old-testpatt ", new: " (args:get-arg "-testpatt"))
      (if (args:get-arg "-runtests")
	  (begin
	    ;; (debug:print 0 "NOTE: Also modifying -runtests")
	    (hash-table-set! args:arg-hash "-runtests" (tack-on-patt (args:get-arg "-runtests")
								     (args:get-arg "-itempatt")))))
      ))

(if (args:get-arg "-logging")(set! *logging* #t))

;;======================================================================
;; Misc general calls
;;======================================================================

(if (args:get-arg "-env2file")
    (begin

(define (server:make-server-url hostport)
  (if (not hostport)
      #f
      (conc "http://" (car hostport) ":" (cadr hostport))))

(define  *server-loop-heart-beat* (current-seconds))
(define *heartbeat-mutex* (make-mutex))
	  (debug:print 0 "Server started on " host:port)

;;======================================================================
;; S E R V E R
;;======================================================================

;; Call this to start the actual server
;;