Megatest

           ezsteps.scm lock-queue.scm api.scm subrun.scm		\
           portlogger.scm archive.scm env.scm diff-report.scm		\
           cgisetup/models/pgdb.scm

# server.scm http-transport.scm client.scm rmt.scm

# module source files
MSRCFILES = dbfile.scm mtargs.scm commonmod.scm dbmod.scm \
            configfmod.scm servermod.scm clientmod.scm rmtmod.scm        \
            artifacts.scm apimod.scm # debugprint.scm

all : $(PREFIX)/bin/.$(ARCHSTR) mtest dboard mtut

# dbmod.import.o is just a hack here
mofiles/dbfile.o mofiles/clientmod.o mofiles/dbmod.o mofiles/rmtmod.o : mofiles/commonmod.o # dbmod.import.o mofiles/debugprint.o
db.o : dbmod.import.o
mofiles/debugprint.o : mofiles/mtargs.o
mofiles/servermod.o  : mofiles/artifacts.o
mofiles/rmtmod.o     : mofiles/apimod.o

# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\

tests.o db.o launch.o runs.o dashboard-tests.o				\
dashboard-context-menu.o dashboard-guimonitor.o dashboard-main.o	\
monitor.o dashboard.o archive.o megatest.o : db_records.scm megatest-fossil-hash.scm

tests.o runs.o dashboard.o dashboard-tests.o dashboard-context-menu.o dashboard-main.o  : run_records.scm

db.o ezsteps.o keys.o launch.o megatest.o monitor.o runs-for-ref.o runs.o tests.o : key_records.scm
db.o api.o : mofiles/dbmod.o mofiles/dbfile.o mofiles/commonmod.o dbmod.import.o # mofiles/debugprint.o

# tests.o tasks.o dashboard-tasks.o : task_records.scm

runs.o : test_records.scm

mofiles-made : $(MOFILES)
	make $(MOIMPFILES)

(declare (unit api))
(declare (uses rmtmod))
(declare (uses db))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tasks))
;; (declare (uses debugprint))

(import dbmod)
(import dbfile)
(import rmtmod
	;; debugprint
	)

;;  strftime('%m/%d/%Y %H:%M:%S','now','localtime')

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18)

(declare (unit archive))
(declare (uses db))
(declare (uses common))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "db_records.scm")

;; (import debugprint)

;;======================================================================

;;(use srfi-18 extras tcp s11n srfi-1 posix regex srfi-69 hostinfo md5
;;     message-digest matchable spiffy uri-common intarweb http-client
;;     spiffy-request-vars uri-common intarweb directory-utils)

(declare (unit clientmod))
(declare (uses servermod))
(declare (uses artifacts))
;; (declare (uses debugprint))

(module clientmod
*

(import scheme
	chicken

     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )

(declare (unit common))
(declare (uses commonmod))
;; (declare (uses debugprint))

(import commonmod
	;; debugprint
	)

(include "common_records.scm")

(declare (unit commonmod))

(use srfi-69)

(module commonmod
	*

(import scheme chicken data-structures extras files ports)
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18 srfi-69
	md5 message-digest
	regex srfi-1)

;;======================================================================
;; CONTENTS

;;
(define (get-cfg-areas cfgdat)
  (let ((adat (get-section cfgdat "areas")))
    (map (lambda (entry)
	   `(,(car entry) . 
	     ,(val->alist (cadr entry))))
	 adat)))

;;======================================================================
;; debugprint
;;======================================================================

;;======================================================================
;; debug stuff
;;======================================================================

(define verbosity (make-parameter '()))
(define *default-log-port*  (current-error-port))
(define debug:print-logger (make-parameter #f)) ;; set to a proc to call on every logging print
	 
(define (debug:setup debug debug-noprop)
  (let ((debugstr (or debug        ;; (args:get-arg "-debug")
      		      debug-noprop ;; (args:get-arg "-debug-noprop")
      		      (get-environment-variable "MT_DEBUG_MODE"))))
    (verbosity (debug:calc-verbosity debugstr 'q))
    (debug:check-verbosity (verbosity) debugstr)
    ;; if we were handed a bad verbosity rule then we will override it with 1 and continue
    (if (not (verbosity))(verbosity 1))
    (if (and (not debug-noprop) ;; (args:get-arg "-debug-noprop")
      	     (or debug          ;; (args:get-arg "-debug")
      		 (not (get-environment-variable "MT_DEBUG_MODE"))))
      	(setenv #;set-environment-variable! "MT_DEBUG_MODE" (if (list? (verbosity))
      				    (string-intersperse (map conc (verbosity)) ",")
      				    (conc (verbosity)))))))

;; check verbosity, #t is ok
(define (debug:check-verbosity verbosity vstr)
  (if (not (or (number? verbosity)
     	       (list?   verbosity)))
      (begin
     	(print "ERROR: Invalid debug value \"" vstr "\"")
     	#f)
      #t))

;;======================================================================
;; (define (debug:print . params) #f)
;; (define (debug:print-info . params) #f)
;; 
;; (define (set-functions dbgp dbgpinfo)
;;   (set! debug:print dbgp)
;;   (set! debug:print-info dbgpinfo))

;;======================================================================
;; this was cached based on results from profiling but it turned out the profiling
;; somehow went wrong - perhaps too many processes writing to it. Leaving the caching
;; in for now but can probably take it out later.
;;
(define (debug:calc-verbosity vstr arg) ;; arg is 'v (verbose) or 'q (quiet)
  (let* ((res (cond
	       ((number? vstr) vstr)
	       ((not (string?  vstr))   1)
	       ;; ((string-match  "^\\s*$" vstr) 1)
	       (vstr           (let ((debugvals  (filter number? (map string->number (string-split vstr ",")))))
				 (cond
				  ((> (length debugvals) 1) debugvals)
				  ((> (length debugvals) 0)(car debugvals))
				  (else 1))))
	       ((eq? arg 'v)   2) ;; verbose
	       ((eq? arg 'q)   0) ;; quiet
	       (else                   1))))
    (verbosity res)
    res))

;;======================================================================
;; check verbosity, #t is ok
#;(define (debug-check-verbosity verbosity vstr)
  (if (not (or (number? verbosity)
	       (list?   verbosity)))
      (begin
	(print "ERROR: Invalid debug value \"" vstr "\"")
	#f)
      #t))

(define (debug:debug-mode n)
  (let* ((vb (verbosity)))
    (cond
     ((and (number? vb)   ;; number number
	   (number? n))
      (<= n vb))
     ((and (list? vb)     ;; list   number
	   (number? n))
      (member n vb))
     ((and (list? vb)     ;; list   list
	   (list? n))
      (not (null? (lset-intersection! eq? vb n))))
     ((and (number? vb)
	   (list? n))
      (member vb n))
     (else #f))))

(define (debug:handle-remote-logging params)
  (if (debug:print-logger) ;; NOTE: turn params into string to keep things simple for now
      ((debug:print-logger)(conc "REMOTE ("(get-host-name)", pid="(current-process-id)") "
				 (string-intersperse (map conc params) " ") "; "
				 (string-intersperse (command-line-arguments) " ")))))

(define debug:enable-timestamp (make-parameter #t))

(define (debug:timestamp)
  (if (debug:enable-timestamp)
      (conc (time->string 
	     (seconds->local-time (current-seconds)) "%H:%M:%S") " ")
      ""))

  (define (debug:print n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (or e (current-error-port))
	(lambda ()
	  ;; (if *logging*
	      ;; (db:log-event (apply conc params))
	  (apply print (debug:timestamp) params)
	  ;; (debug:handle-remote-logging params)
	  )))
  #t ;; only here to make remote stuff happy. It'd be nice to fix that ...
  )

(define (debug:print-error n e . params)
  ;; normal print
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (apply print "ERROR: " (debug:timestamp) params)
	  ;; (debug:handle-remote-logging (cons "ERROR: " params))
	  )))
  ;; pass important messages to stderr
  (if (and (eq? n 0)(not (eq? e (current-error-port)))) 
      (with-output-to-port (current-error-port)
	(lambda ()
	  (apply print "ERROR: " (debug:timestamp) params)
	  ))))

(define (debug:print-info n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (apply print "INFO: (" n ") "(debug:timestamp) params) ;; res)
	  ;; (debug:handle-remote-logging (cons "INFO: " params))
	  ))))

(define (debug:print-warn n e . params)
  (if (debug:debug-mode n)
      (with-output-to-port (if (port? e) e (current-error-port))
	(lambda ()
	  (apply print "WARN: (" n ") " (debug:timestamp) params) ;; res)
	  ;; (debug:handle-remote-logging (cons "WARN: " params))
	  ))))

;;======================================================================
;; misc stuff
;;======================================================================

)

;;======================================================================

(use regex regex-case matchable) ;;  directory-utils)
(declare (unit configf))
(declare (uses process))
(declare (uses env))
(declare (uses keys))
;; (declare (uses debugprint))

(include "common_records.scm")

;; (import debugprint)

;; return list (path fullpath configname)
(define (find-config configname #!key (toppath #f))

;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit configfmod))
(declare (uses mtargs))
;; (declare (uses debugprint))
;; (declare (uses keysmod))

(module configfmod
*	

(import srfi-1
  

(declare (uses db))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
;; (declare (uses debugprint))


(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;; (import debugprint)

(declare (uses db))
(declare (uses gutils))
(declare (uses rmtmod))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;; (import debugprint)

;;======================================================================
;; C O M M O N
;;======================================================================

(define *dashboard-comment-share-slot* #f)

(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbfile))        
;; (declare (uses debugprint))

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")

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

	3)))

(define (get-curr-sort)
  (vector-ref *tests-sort-options* *tests-sort-reverse*))

;;======================================================================

(debug:setup (args:get-arg "-debug")(args:get-arg "-debug-noprop"))

;; (define uidat #f)

(define-inline (dboard:uidat-get-keycol  vec)(vector-ref vec 0))
(define-inline (dboard:uidat-get-lftcol  vec)(vector-ref vec 1))
(define-inline (dboard:uidat-get-header  vec)(vector-ref vec 2))
(define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3))

     z3
     typed-records
     matchable
     files)

(declare (unit db))
(declare (uses common))
(declare (uses commonmod))
(declare (uses dbmod))
;; (declare (uses debugprint))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
;; (declare (uses client))
(declare (uses mt))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

(define *number-of-writes* 0)
(define *number-non-write-queries* 0)

(import dbmod
	dbfile
	commonmod
	;; debugprint
	)

;; record for keeping state,status and count for doing roll-ups in
;; iterated tests
;;
(defstruct dbr:counts

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit dbfile))
;; (declare (uses debugprint))
(declare (uses commonmod))

(module dbfile
	*
	
  (import scheme
	  chicken

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit dbmod))
(declare (uses commonmod))
;; (include "debugprint.scm")

(module dbmod
	*
	
(import scheme
	chicken
	ports
	s11n
	z3
	
	data-structures
	extras
	(prefix base64 base64:)
	message-digest
	regex

	commonmod ;; debugprint
	)

(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18
	srfi-69)

(define (db:run-id->dbname run-id)

(use regex typed-records matchable)

(declare (unit dcommon))

(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))
;; (declare (uses debugprint))

(import commonmod
	;; debugprint
	)
;; (declare (uses synchash))

(include "megatest-version.scm")

;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(declare (unit diff-report))
(declare (uses common))
(declare (uses rmtmod))
;; (declare (uses debugprint))
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
;; (import debugprint)

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit env))
;; (declare (uses debugprint))

(use sql-de-lite) ;; srfi-1 posix regex regex-case srfi-69 srfi-18 call-with-environment-variables)

;; (import debugprint)

(define (env:open-db fname)
  (let* ((db-exists (common:file-exists? fname))

     z3 csv typed-records pathname-expand matchable)

(declare (unit ezsteps))
(declare (uses db))
(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses debugprint))
;; (declare (uses sdb))
;; (declare (uses filedb))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit genexample))
;; (declare (uses debugprint))

(use posix regex matchable)
;; (import debugprint)

(include "db_records.scm")

(define genexample:example-logpro

;; (define itemdat '((ripeness    "green ripe overripe")
;; 		     (temperature "cool medium hot")
;; 		     (season      "summer winter fall spring")))

(declare (unit items))
(declare (uses common))
;; (declare (uses debugprint))

(include "common_records.scm")

;; (import debugprint)

;; Puts out all combinations
(define (process-itemlist hierdepth curritemkey itemlist)

 
;;======================================================================
;; Run keys, these are used to hierarchially organise tests and run areas
;;======================================================================

(declare (unit keys))
(declare (uses common))
;; (declare (uses debugprint))

(use srfi-1 posix regex regex-case srfi-69
     (prefix sqlite3 sqlite3:))

;; (import debugprint)
	

(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses configf))
(declare (uses db))
(declare (uses ezsteps))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "megatest-fossil-hash.scm")

;; (import debugprint)

;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(declare (unit lock-queue))
(declare (uses common))
(declare (uses tasks))
;; (declare (uses debugprint))

(use (prefix sqlite3 sqlite3:) srfi-18)
;; (import debugprint)

;;======================================================================
;; attempt to prevent overlapping updates of rollup files by queueing
;; update requests in an sqlite db

;; (include "common.scm")
(include "megatest-version.scm")

;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

;; notes:
;;    1. the uses of .import are needed
;;    2. the order is important
;;    
(declare (uses common))
(declare (uses commonmod))
(declare (uses commonmod.import))
(declare (uses dbfile))
(declare (uses dbfile.import))

;; (declare (uses megatest-version))
(declare (uses margs))
(declare (uses runs))
(declare (uses launch))
(declare (uses tests))
(declare (uses genexample))
;; (declare (uses daemon))

(declare (uses db))
;; (declare (uses dcommon))

(declare (uses tdb))
(declare (uses mt))
(declare (uses api))
(declare (uses tasks)) ;; only used for debugging.
(declare (uses env))
(declare (uses diff-report))
(declare (uses db))
(declare (uses dbmod))
;; (declare (uses dbmod.import))
(declare (uses rmtmod))
(declare (uses clientmod))
(declare (uses servermod))

;; (declare (uses commonmod.import))

;; (declare (uses dbfile.import))
;; (declare (uses debugprint))
;; ;; (declare (uses debugprint.import))
;; (declare (uses mtargs))
;; (declare (uses mtargs.import))

;; (declare (uses ftail))
;; (import ftail)

(import commonmod

	dbfile
	
	dbmod
	servermod
	;; debugprint.import
	;; debugprint
	)

(define *db* #f) ;; this is only for the repl, do not use in general!!!!

    (debug:print 0 *default-log-port* (string-intersperse (argv) " ")))


;;======================================================================
;; Misc setup stuff
;;======================================================================

(debug:setup (args:get-arg "-debug")(args:get-arg "-debug-noprop"))

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

;;(if (debug:debug-mode 3) ;; we are obviously debugging
;;    (set! open-run-close open-run-close-no-exception-handling))

(if (args:get-arg "-itempatt")

(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses servermod))
(declare (uses runs))
(declare (uses rmtmod))
;; (declare (uses filedb))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

     (prefix sqlite3 sqlite3:)
     nanomsg)

(declare (uses common))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
;; (declare (uses debugprint))

(use ducttape-lib)

;; (import debugprint)

(include "megatest-fossil-hash.scm")

;; (declare (uses launch))
;; (declare (uses gutils))
;; (declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
;; (declare (uses debugprint))

;; (declare (uses tree))
;; 
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "key_records.scm")
;; (import debugprint)

(require-extension (srfi 18) extras tcp s11n)

(use sqlite3 srfi-1 posix srfi-69 hostinfo dot-locking z3)
(import (prefix sqlite3 sqlite3:))

(declare (unit portlogger))
(declare (uses db))
;; (declare (uses debugprint))
;; (import debugprint)

;; lsof -i

(define (portlogger:open-db fname)
  (let* ((avail    (tasks:wait-on-journal fname 5 remove: #t)) ;; wait up to about 10 seconds for the journal to go away
	 (exists   (common:file-exists? fname))

;;======================================================================
;; Process convience utils
;;======================================================================

(use regex directory-utils)
(declare (unit process))
;; (declare (uses debugprint))

;; (import debugprint)

(define (process:conservative-read port)
  (let loop ((res ""))
    (if (not (eof-object? (peek-char port)))
	(loop (conc res (read-char port)))

(use format typed-records) ;; RADT => purpose of json format??

(declare (unit rmt))
(declare (uses api))
(declare (uses http-transport))
(declare (uses dbfile))
;; (declare (uses debugprint))

(include "common_records.scm")
;; (declare (uses rmtmod))

(import dbfile
	;; debugprint
	) ;; rmtmod)

;;======================================================================

(declare (unit rmtmod))
(declare (uses commonmod))
(declare (uses clientmod))
(declare (uses dbmod))
;; (declare (uses debugprint))
(declare (uses apimod))

;; (include "debugprint.scm")

(module rmtmod
*

(import scheme
	chicken
	data-structures
	posix
	;; regex
	srfi-1
	srfi-18
	srfi-69
	extras

	commonmod
	clientmod
	dbmod
	apimod
	;; debugprint
	)

;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following

;;======================================================================
;; read a config file, loading only the section pertinent
;; to this run field1val/field2val/field3val ...
;;======================================================================

(declare (unit runconfig))
(declare (uses common))
;; (declare (uses debugprint))

(use format directory-utils)

;; (import debugprint)

(include "common_records.scm")

(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses servermod))
(declare (uses mt))
(declare (uses archive))
;; (declare (uses filedb))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

;; 
;;     You should have received a copy of the GNU General Public License
;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;======================================================================

(declare (unit servermod))
(declare (uses artifacts))
;; (declare (uses debugprint))

(use md5 message-digest posix typed-records extras)

(module servermod
*

(import scheme

;;(declare (uses items))
;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))
;; (declare (uses debugprint))

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format
     call-with-environment-variables)

;; (import debugprint)

(declare (unit tasks))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmtmod))
(declare (uses common))
(declare (uses pgdb))
;; (declare (uses debugprint))

(import dbfile
	;; debugprint
	)
;; (import pgdb) ;; pgdb is a module

(include "db_records.scm")

(declare (unit tdb))
(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses clientmod))
(declare (uses mt))
(declare (uses db))
;; (declare (uses debugprint))

(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")
(include "run_records.scm")

;; (import debugprint)

(declare (uses commonmod))
;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(declare (uses servermod))
;;(declare (uses stml2))
;; (declare (uses debugprint))

;; (import debugprint)

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
(import commonmod)
(require-library stml)

(declare (uses launch))
;; (declare (uses megatest-version))
(declare (uses gutils))
(declare (uses db))
;; (declare (uses server))
;; (declare (uses synchash))
(declare (uses dcommon))
;; (declare (uses debugprint))

(include "megatest-version.scm")
(include "common_records.scm")
(include "db_records.scm")
(include "key_records.scm")

;; (import debugprint)