Megatest

(declare (unit api))
(declare (uses rmt))
(declare (uses db))
(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tasks))

(declare (uses tcp-transportmod))

(import dbmod)
(import dbfile)
(import debugprint)

(import tcp-transportmod)

(use srfi-69
     posix
     matchable
     s11n)

(declare (unit archive))
(declare (uses db))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses common))
(declare (uses commonmod))


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

(import commonmod
	debugprint

	(prefix mtargs args:))

(include "common_records.scm")
(include "db_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 common))
(declare (uses commonmod))

(declare (uses debugprint))
(declare (uses mtargs))

(use srfi-1 data-structures posix regex-case (prefix base64 base64:)
     format dot-locking csv-xml z3 udp ;; sql-de-lite
     hostinfo md5 message-digest typed-records directory-utils stack
     matchable regex posix (srfi 18) extras ;; tcp 
     (prefix nanomsg nmsg:)
     (prefix sqlite3 sqlite3:)
     pkts (prefix dbi dbi:)
     )
(use posix-extras pathname-expand files)


(import commonmod
	debugprint

	(prefix mtargs args:))

(include "common_records.scm")


;; (require-library margs)
;; (include "margs.scm")

(declare (unit dashboard-context-menu))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))

(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

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

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

(import commonmod

	debugprint)

(define (dboard:launch-testpanel run-id test-id)
  (let* ((dboardexe (common:find-local-megatest "dashboard"))
         (cmd (conc dboardexe
                    " -test " run-id "," test-id
                    " &")))

(declare (unit dashboard-tests))
(declare (uses common))
(declare (uses commonmod))
(declare (uses db))
(declare (uses gutils))
(declare (uses rmt))
(declare (uses ezsteps))
;; (declare (uses sdb))
;; (declare (uses filedb))
(declare (uses subrun))
(declare (uses debugprint))

(use format fmt)
(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)

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

(import commonmod

	debugprint)

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

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

(declare (uses tree))
(declare (uses dcommon))
(declare (uses dashboard-context-menu))
(declare (uses vg))
(declare (uses subrun))
(declare (uses mt))
(declare (uses dbmod))
;; (declare (uses dbmemmod))
(declare (uses dbfile))
(declare (uses commonmod))
(declare (uses commonmod.import))

(use format)

(require-library iup)
(import (prefix iup iup:))

(use canvas-draw)
(import canvas-draw-iup
	(prefix sqlite3 sqlite3:))

(use ducttape-lib)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 typed-records sparse-vectors) ;; defstruct

(import commonmod
	(prefix mtargs args:)
	dbmod
	dbfile

	debugprint)

(include "common_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "task_records.scm")
(include "megatest-version.scm")

(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses keys))
(declare (uses ods))
(declare (uses mt))
(declare (uses commonmod))
(declare (uses mtargs))


(import commonmod
	(prefix mtargs args:))

(use (srfi 18)
     extras
     tcp

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

(import debugprint)
(import dbmod)
(import dbfile)


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

;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;     GNU General Public License for more details.
;; 
;;     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
	  data-structures
	  extras
	  matchable)
  
(import (prefix sqlite3 sqlite3:)
	posix typed-records srfi-18 srfi-1



	srfi-69
	stack
	files
	ports

	commonmod
	debugprint
	)

;; parameters
;;
(define dbfile:testsuite-name (make-parameter #f))

(define keep-age-param        (make-parameter 10))      ;; qif file age, if over move to attic
(define num-run-dbs           (make-parameter 10))      ;; number of db's in .mtdb

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

;; call with dbinit=db:initialize-main-db
;;
(define (db:open-db dbstruct run-id dbinit)
  ;; (mutex-lock! *db-open-mutex*)
  (let* ((dbdat (dbfile:open-db dbstruct run-id dbinit)))
              #;(case (rmt:transport-mode)
		  ((http) (dbfile:open-db dbstruct run-id dbinit))
		  ((tcp)  (dbmod:open-db  dbstruct run-id dbinit))
		  (else (assert #f "FATAL: rmt:transport-node not correct value"(rmt:transport-mode))))
    (set! *db-write-access* (not (dbr:dbdat-read-only dbdat)))
    ;; (mutex-unlock! *db-open-mutex*)
    dbdat))

(define dbfile:db-init-proc (make-parameter #f))

;; in xmaxima this gives a curve close to what I want:

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

(declare (unit dcommon))

(declare (uses gutils))
(declare (uses db))
(declare (uses commonmod))


(use format)
(require-library iup)
(import (prefix iup iup:))
(use canvas-draw)
(import canvas-draw-iup)
(use regex typed-records matchable)

(import commonmod

	debugprint)
;; (declare (uses synchash))

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

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.
;;

(declare (unit diff-report))
(declare (uses common))
(declare (uses debugprint))
(declare (uses rmt))

(declare (uses commonmod))
(import commonmod

	debugprint)
         
(include "common_records.scm")
(use matchable)
(use fmt)
(use ducttape-lib)
(define css "")

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

(use srfi-1 posix regex srfi-69 directory-utils call-with-environment-variables posix-extras
     z3 csv typed-records pathname-expand matchable)

(import commonmod
	debugprint

	(prefix mtargs args:))

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

;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

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

(declare (unit genexample))
(declare (uses mtargs))
(declare (uses debugprint))


(use posix regex matchable)
(import (prefix mtargs args:)

	debugprint)

(include "db_records.scm")

(define genexample:example-logpro
#<<EOF
  ;; You should have at least one expect:required. This ensures that your process ran

(declare (unit launch))
(declare (uses subrun))
(declare (uses common))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses configf))
(declare (uses db))

(declare (uses ezsteps))
(declare (uses dbfile))
(declare (uses mtargs))

(use regex regex-case base64 sqlite3 srfi-18 directory-utils posix-extras z3
     call-with-environment-variables csv)
(use typed-records pathname-expand matchable)

(import (prefix base64 base64:)
	(prefix sqlite3 sqlite3:)
	(prefix mtargs args:)

	debugprint)

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

(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses runs))
(declare (uses rmt))
;; (declare (uses filedb))

(import debugprint)


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

	dbmod
	tcp-transportmod)

;; http - use the old http + in /tmp db
;; tcp  - use tcp transport with inmem db
;; nfs  - use direct to disk access (read-only)
;;
(define rmt:transport-mode (make-parameter 'http))
;;
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;; generate entries for ~/.megatestrc with the following
;;
;;  grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u

;; This login does no retries under the hood - it acts a bit like a ping.
;; Deprecated for nmsg-transport.
;;
;; (define (rmt:login-no-auto-client-setup runremote)
;;   (rmt:send-receive-no-auto-client-setup runremote 'login 0 (list *toppath* megatest-version (client:get-signature))))

;; hand off a call to one of the db:queries statements
;; added run-id to make looking up the correct db possible 
;;
(define (rmt:general-call stmtname run-id . params)
  (rmt:send-receive 'general-call run-id (append (list stmtname run-id) params)))


;; given a hostname, return a pair of cpu load and update time representing latest intelligence from tests running on that host
(define (rmt:get-latest-host-load hostname)
  (rmt:send-receive 'get-latest-host-load 0 (list hostname)))

(define (rmt:sdb-qry qry val run-id)
  ;; add caching if qry is 'getid or 'getstr

(defstruct alldat
  (areapath #f)
  (ulexdat  #f)
  )

;; hold the send-receive proc in this parameter
(define rmtmod:send-receive #f) ;; (make-parameter #f))













;;======================================================================
;; import an sexpr file into the db
;;======================================================================

(define (rmt:import-sexpr sexpr-file)
  (if (file-exists? sexpr-file)

(define (rmt:insert-test run-id test-rec)
  (let* ((testname  (alist-ref "testname" test-rec equal?))
	 (item-path (alist-ref "item_path" test-rec equal?)))
    (debug:print 0 *default-log-port* "   Insert test in run "run-id": "testname"/"item-path)
    (rmtmod:send-receive 'insert-test run-id test-rec)))

;;======================================================================
;; return the handle struct for sending queries to a specific database
;;  - initializes the connection object if this is the first access
;;    - finds the "captain" and asks who to talk to for the given dbfname
;;    - establishes the connection to the current dbowner
;;
#;(define (rmt:connect alldat dbfname dbtype)
  (let* ((ulexdat    (or (alldat-ulexdat alldat)
			 (rmt:setup-ulex alldat))))
    (ulex:connect ulexdat dbfname dbtype)))

;; setup the remote calls
#;(define (rmt:setup-ulex alldat)
  (let* ((udata (ulex:setup))) ;; establish connection to ulex
    (alldat-ulexdat-set! alldat udata)
    ;; register all needed procs
    (ulex:register-handler udata 'ping cmod:get-full-version)  ;; override ping with get-full-version
    (ulex:register-handler udata 'login cmod:get-full-version) ;; force setup of the connection
    (ulex:register-handler udata 'execute api:execute-requests)
    udata))

;; set up a connection to the current owner of the dbfile associated with rid
;; then send the query to that dbfile owner and wait for a response.
;;
#;(define (rmt:send-receive alldat cmd rid params #!key (attemptnum 1)(area-dat #f)) ;; start attemptnum at 1 so the modulo below works as expected
  (let* (;; (alldat   *alldat*)
	 (areapath (alldat-areapath alldat))
	 (dbtype   (if (or (not rid)(< rid 1)) ;; this is the criteria for "main.db"
		       "main" "runs"))
	 (dbfname  (if (equal? dbtype "main")
		       "main.db"
		       (conc rid ".db")))
	 (dbfile   (conc areapath "/.db/" dbfname))
	 (ulexconn (rmt:connect alldat dbfname dbtype))  ;; ulexconn is our new *runremote*, it is a dbowner struct < pdat lastrefresh >
	 (udata    (alldat-ulexdat alldat)))
    	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid params)))
    ;; need to call this on the other side 
    ;; (api:execute-requests dbstruct-local (vector (symbol->string cmd) params))))
    
    #;(with-input-from-string
	(ulex:remote-request udata ulexconn 'immediate dbfile 'execute rid (with-output-to-string (lambda ()(serialize params))))
       (lambda ()(deserialize)))
)

(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses mt))
(declare (uses archive))
(declare (uses mtargs))


(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18) 
     posix-extras directory-utils pathname-expand typed-records format  sxml-serializer
     sxml-modifications matchable)



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

;; (include "debugger.scm")

(import commonmod
	debugprint

	(prefix mtargs args:))

;; use this struct to facilitate refactoring
;;

(defstruct runs:dat
  reglen regfull

(use format)
(use srfi-1 srfi-69 sqlite3)
(import (prefix sqlite3 sqlite3:))

(declare (unit synchash))
(declare (uses db))
(declare (uses server))


(include "db_records.scm")



(define (synchash:make)
   (make-hash-table))

;; given an alist of objects '((id obj) ...) 
;;   1. remove unchanged objects from the list
;;   2. create a list of removed objects by id

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

(declare (unit tasks))
(declare (uses debugprint))
(declare (uses dbfile))
(declare (uses db))
(declare (uses rmt))

(declare (uses common))
(declare (uses pgdb))
(declare (uses commonmod))
(declare (uses mtargs))

(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking format)
(import (prefix sqlite3 sqlite3:))

(import commonmod
	debugprint

	(prefix mtargs args:))

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

(include "task_records.scm")
(include "db_records.scm")

;;
;;  1. Run the megatest process and pass it all the needed parameters
;;  2. Every five seconds check for state/status changes and print the info
;;

(declare (uses mtargs))
(declare (uses rmt))

(declare (uses common))
;; (declare (uses megatest-version))
(declare (uses commonmod))

(use srfi-1 posix srfi-69 srfi-18 regex defstruct)

(use trace)
;; (trace-call-sites #t)

(import commonmod

	(prefix mtargs args:))

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

(define origargs (cdr (argv)))

(declare (uses common))
(declare (uses keys))
(declare (uses ods))
(declare (uses mt))
(declare (uses db))
(declare (uses commonmod))
(declare (uses mtargs))


(require-extension (srfi 18) extras tcp)
(use sqlite3 srfi-1 posix regex regex-case srfi-69 csv-xml s11n md5 message-digest base64)
(import (prefix sqlite3 sqlite3:))
(import (prefix base64 base64:))

(import commonmod
	debugprint

	(prefix mtargs args:))

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

;; (declare (uses dcommon)) ;; needed for the steps processing
(declare (uses items))
(declare (uses runconfig))
;; (declare (uses sdb))
(declare (uses server))
;;(declare (uses stml2))
(declare (uses mtargs))


(use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils)
(import (prefix sqlite3 sqlite3:))
(import commonmod
	(prefix mtargs args:)
	debugprint)

(require-library stml)

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