Megatest

	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/nbfind : utils/nbfind
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/loadrunner : utils/loadrunner
	$(INSTALL) $< $@
	chmod a+x $@

$(PREFIX)/bin/refdb : refdb
	$(INSTALL) $< $@
	chmod a+x $@

# install dashboard as dboard so wrapper script can be called dashboard
$(PREFIX)/bin/dboard : dboard $(FILES)
	$(INSTALL) dboard $(PREFIX)/bin/dboard
	utils/mk_wrapper $(PREFIX) dboard > $(PREFIX)/bin/dashboard
	chmod a+x $(PREFIX)/bin/dashboard

install : bin $(PREFIX)/bin/mtest $(PREFIX)/bin/megatest $(PREFIX)/bin/dboard $(PREFIX)/bin/dashboard $(HELPERS) $(PREFIX)/bin/nbfake \
          $(PREFIX)/bin/nbfind $(PREFIX)/bin/loadrunner $(PREFIX)/bin/newdboard $(PREFIX)/bin/refdb $(PREFIX)/bin/mt_xterm $(PREFIX)/bin/revtagfsl

deploytarg/apropos.so : Makefile
	for i in apropos base64 canvas-draw csv-xml directory-utils dot-locking extras fmt format hostinfo http-client intarweb json md5 message-digest posix posix-extras readline regex regex-case s11n spiffy spiffy-request-vars sqlite3 srfi-1 srfi-18 srfi-69 tcp test uri-common check-errors synch matchable sql-null tcp-server rpc blob-utils string-utils variable-item defstruct uri-generic sendfile opensll openssl lookup-table list-utils stack; do \
	chicken-install -prefix deploytarg -deploy $$i;done

deploytarg/libsqlite3.so : 
	CSC_OPTIONS="-Ideploytarg -Ldeploytarg" $CHICKEN_INSTALL -prefix deploytarg -deploy sqlite3

    ((set-tests-state-status)       (apply db:set-tests-state-status dbstruct params))
    ((get-tests-for-run)            (apply db:get-tests-for-run dbstruct params))
    ((get-test-id)                  (apply db:get-test-id dbstruct params))
    ((get-tests-for-runs-mindata)   (apply db:get-tests-for-runs-mindata dbstruct params))
    ((get-run-name-from-id)         (apply db:get-run-name-from-id dbstruct params))
    ((delete-run)                   (apply db:delete-run dbstruct params))
    ((get-runs)                     (apply db:get-runs dbstruct params))
    ((get-all-run-ids)              (db:get-all-run-ids dbstruct))
    ((get-runs-by-patt)             (apply db:get-runs-by-patt dbstruct params))
    ((lock/unlock-run)              (apply db:lock/unlock-run dbstruct params))
    ((update-run-event_time)        (apply db:update-run-event_time dbstruct params))

    ;; STEPS
    ((teststep-set-status!)         (apply db:teststep-set-status! dbstruct params))

;; (define (db:get-path dbstruct id)
;;   (let ((fdb (db:get-filedb dbstruct)))
;;     (filedb:get-path db id)))

;; This routine creates the db. It is only called if the db is not already opened
;; 
(define (db:open-rundb dbstruct run-id) ;;  (conc *toppath* "/megatest.db") (car *configinfo*)))
  (let ((rdb (dbr:dbstruct-get-runvec-val dbstruct run-id 'inmem))) ;; (dbr:dbstruct-get-runrec dbstruct run-id 'inmem)))
    (if rdb
	rdb
	(let* ((local        (dbr:dbstruct-get-local dbstruct))
	       (toppath      (dbr:dbstruct-get-path dbstruct))
	       (dbpath       (conc toppath "/db/" run-id ".db"))
	       (dbexists     (file-exists? dbpath))
	       (inmem        (if local #f (db:open-inmem-db)))

	      (begin
		(if (not dbexists)
		    (begin
		      (db:initialize-run-id-db db)
		      ;; (sdb:initialize db) 
		      )) ;; add strings db to rundb, not in use yet
		(sqlite3:set-busy-handler! db handler)
		(sqlite3:execute db "PRAGMA synchronous = 1;"))) ;; was 0 but 0 is a gamble
	  (dbr:dbstruct-set-runvec-val! dbstruct run-id 'rundb db)
	  (dbr:dbstruct-set-runvec-val! dbstruct run-id 'inuse #t)
	  (if local
	      (begin
		(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inmem db) ;; direct access ...
		db)
	      (begin

    (sqlite3:for-each-row 
     (lambda (count)
       (set! numruns count))
     (db:get-db dbstruct #f)
     "SELECT COUNT(id) FROM runs WHERE runname LIKE ? AND state != 'deleted';" runpatt)
    (debug:print-info 11 "db:get-num-runs END " runpatt)
    numruns))

(define (db:get-all-run-ids dbstruct)
  (let ((run-ids '()))
    (sqlite3:for-each-row
     (lambda (run-id)
       (set! run-ids (cons run-id run-ids)))
     (db:get-db dbstruct #f)
     "SELECT id FROM runs WHERE state != 'deleted';")
    run-ids))

;; get some basic run stats
;;
;; ( (runname (( state  count ) ... ))
;;   (   ...  
(define (db:get-run-stats dbstruct)
  (let ((totals       (make-hash-table))

;;
(define (db:get-count-tests-running dbstruct run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     (db:get-db dbstruct run-id)
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" 
     run-id) ;; NOT IN (SELECT id FROM runs WHERE state='deleted');")
    res))

;; NEW BEHAVIOR: Look only at single run with run-id
;; 
;; (define (db:get-running-stats dbstruct run-id)
(define (db:get-count-tests-running-for-run-id dbstruct run-id)
  (let ((res 0))
    (sqlite3:for-each-row
     (lambda (count)
       (set! res count))
     (db:get-db dbstruct run-id)
     "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND run_id=?;" run-id)
    res))

(define (db:get-count-tests-running-in-jobgroup dbstruct run-id jobgroup)
  (if (not jobgroup)
      0 ;; 
      (let ((res        0)
	    (testnames '()))
	;; get the testnames
	(sqlite3:for-each-row
	 (lambda (testname)
	   (set! testnames (cons testname testnames)))
	 (db:get-db dbstruct #f)
	 "SELECT testname FROM test_meta WHERE jobgroup=?"
	 jobgroup)
	;; get the jobcount NB// EXTEND THIS TO OPPERATE OVER ALL RUNS?
	(if (not (null? testnames))
	    (sqlite3:for-each-row
	     (lambda (count)
	       (set! res count))
	     (db:get-db dbstruct run-id)
	     (conc "SELECT count(id) FROM tests WHERE state in ('RUNNING','LAUNCHED','REMOTEHOSTSTART') AND testname in ('"
		   (string-intersperse testnames "','")
		   "');")))
	res)))

;; done with run when:
;;   0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
(define (db:estimated-tests-remaining dbstruct run-id)
  (let ((res 0))
    (sqlite3:for-each-row

      (rmt:send-receive 'get-tests-for-run run-id (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals))
      (begin
	(debug:print "ERROR: rmt:get-tests-for-run called with bad run-id=" run-id)
	(print-call-chain)
	'())))

(define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in)
  (let ((run-id-list (if run-ids
			 run-ids
			 (rmt:get-all-run-ids))))
    (apply append (map (lambda (run-id)
			 (rmt:send-receive 'get-tests-for-run-mindata run-id (list run-ids testpatt states status not-in)))
		       run-id-list))))

(define (rmt:delete-test-records run-id test-id)
  (rmt:send-receive 'delete-test-records run-id (list run-id test-id)))

(define (rmt:test-set-status-state run-id test-id status state msg)
  (rmt:send-receive 'test-set-status-state run-id (list run-id test-id status state msg)))

(define (rmt:delete-old-deleted-test-records)
  (rmt:send-receive 'delete-old-deleted-test-records '()))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs (list runpatt count offset keypatts)))

(define (rmt:get-runs runpatt count offset keypatts)
  (rmt:send-receive 'get-runs (list runpatt count offset keypatts)))

(define (rmt:get-all-run-ids)
  (rmt:send-receive 'get-all-run-ids #f '()))

(define (rmt:lock/unlock-run run-id lock unlock user)
  (rmt:send-receive 'lock/unlock-run (list run-id lock unlock user)))

(define (rmt:update-run-event_time run-id)
  (rmt:send-receive 'update-run-event_time (list run-id)))

(define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) 
  (let ((tdb  (rmt:open-test-db-by-test-id run-id test-id work-area: work-area)))
    (if tdb
	(tdb:read-test-data tdb test-id categorypatt)
	'())))

(define (rmt:testmeta-add-record testname)
  (rmt:send-receive 'testmeta-add-record #f (list testname)))

(define (rmt:testmeta-get-record testname)
  (rmt:send-receive 'testmeta-get-record #f (list testname)))

(define (rmt:testmeta-update-field test-name fld val)
  (rmt:send-receive 'testmeta-update-field #f (list test-name fld val)))

(define (rmt:test-data-rollup run-id test-id status)
  (rmt:send-receive 'test-data-rollup run-id (list run-id test-id status)))

(define (rmt:csv->test-data run-id test-id csvdata)
  (rmt:send-receive 'csv->test-data run-id (list run-id test-id csvdata)))

	      (list "default" target))
    (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id)))

(define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f))
  (let* ((target      (or (args:get-arg "-reqtarg")
			  (args:get-arg "-target")
			  (get-environment-variable "MT_TARGET")))
	 (keys    (if inkeys    inkeys    (rmt:get-keys run-id)))
	 (keyvals (if inkeyvals inkeyvals (keys:target->keyval keys target)))
	 (vals (hash-table-ref/default *env-vars-by-run-id* run-id #f)))
    ;; get the info from the db and put it in the cache
    (if (not vals)
	(let ((ht (make-hash-table)))
	  (hash-table-set! *env-vars-by-run-id* run-id ht)
	  (set! vals ht)

   (common:version-signature) ;; mt_version
   -1                         ;; interface
   "http"                     ;; transport
   run-id
   ))

(define (tasks:server-clean-out-old-records-for-run-id mdb run-id)
  (sqlite3:execute mdb "DELETE FROM servers WHERE state in ('available','shutting-down') AND (strftime('%s','now') - start_time) > 30 AND run_id=?;" run-id)
  (sqlite3:execute mdb "DELETE FROM servers WHERE state='running' AND (strftime('%s','now') - heartbeat)  > 10 AND run_id=?;" run-id)
  )
  

(define (tasks:server-set-state! mdb server-id state)
  (sqlite3:execute mdb "UPDATE servers SET state=? WHERE id=?;" state server-id))

(define (tasks:server-delete-record! mdb server-id)
  (sqlite3:execute mdb "DELETE FROM servers WHERE id=?;" server-id))

       (set! res (vector id interface port pubport transport pid hostname)))
     mdb
     "SELECT id,interface,port,pubport,transport,pid,hostname FROM servers
          WHERE strftime('%s','now')-heartbeat < 10 
          AND mt_version=? AND run_id=? AND state='running'
          ORDER BY start_time DESC LIMIT 1;" (common:version-signature) run-id)
    res))

(define (tasks:get-all-servers mdb)
  (let ((res  #f))
    (sqlite3:for-each-row
     (lambda (id interface port pubport transport pid hostname)
       (set! res (cons (vector id interface port pubport transport pid hostname) res)))
     mdb
     "SELECT id,interface,port,pubport,transport,pid,hostname FROM servers
          WHERE strftime('%s','now')-heartbeat < 10 
          AND mt_version=? 
          ORDER BY start_time DESC;" (common:version-signature))
    res))

(define (tasks:kill-server status hostname port pid transport)
  (debug:print-info 1 "Removing defunct server record for " hostname ":" port)
  (if port
      (open-run-close tasks:server-deregister tasks:open-db hostname port: port)
      (open-run-close tasks:server-deregister tasks:open-db hostname pid:  pid))
  (if status ;; #t means alive

[setup]
# exectutable /path/to/megatest
max_concurrent_jobs 250

linktree #{getenv MT_RUN_AREA_HOME}/tmp/mt_links

[jobtools]
useshell yes
# ## launcher launches jobs, the job is managed on the target host
## by megatest, comment out launcher to run local
# workhosts localhost hermes
# launcher exec nbfake
# launcher nbfake
launcher loadrunner
# launcher echo

# launcher nbfind
# launcher nodanggood

## use "xterm -e csi -- " as a launcher to examine the launch environment.
## exit with (exit)