Megatest

(declare (uses debugprint))
(declare (uses dbmod))
(declare (uses dbfile))
(declare (uses tcp-transportmod))
(declare (uses megatestmod))

(module apimod

	(
	 api:dispatch-request
	 )
	
(import scheme chicken data-structures extras)
(import (prefix sqlite3 sqlite3:) posix matchable typed-records srfi-1 srfi-18 srfi-69 )
(import commonmod)
(import debugprint)
(import dbmod)
(import dbfile)

(declare (uses mtmod))
(declare (uses dbmod))
(declare (uses dbfile))

(use srfi-69)

(module archivemod
	(
	 archive:get-archive-disks
	 archive:allocate-new-archive-block
	 archive:get-timestamp-dir
	 archive:megatest-db
	 archive:bup-get-data


	 )

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

     z3)

(import stml2
	)

(module commonmod
	(
	 keys->valslots
	 item-list->path
	 common:human-time
	 number-of-processes-running
	 get-normalized-cpu-load
	 common:find-local-megatest

	 common:get-intercept
	 common:get-num-cpus
	 common:get-cpu-load
	 common:hms-string->seconds
	 seconds->time-string
	 common:get-megatest-exe

	 megatest-version
	 common:get-toppath
	 common:generic-ssh
	 common:file-exists?
	 common:with-env-vars
	 common:nice-path
	 common:get-fields

	 common:get-normalized-cpu-load
	 common:unix-ping
	 common:get-normalized-cpu-load

	 ;; globals
	 *common:badly-ended-states*
	 *common:dont-roll-up-states*
	 *common:ended-states*
	 *common:not-started-ok-statuses*
	 *common:running-states*
	 *common:std-states*
	 *common:std-statuses*
	 *common:well-ended-states*
	 *configdat*
	 *configinfo*
	 *db-access-allowed*
	 *db-api-call-time*
	 *db-cache-path*
	 *db-keys*
	 *default-area-tag*
	 *host-loads*
	 *keyvals*
	 *logged-in-clients*
	 *my-client-signature*
	 *on-exit-procs*
	 *pkts-info*
	 *pre-reqs-met-cache*
	 *runremote*
	 *server-id*
	 *server-info*
	 *target*
	 *task-db*
	 *testconfigs*
	 *time-to-exit*
	 *toppath*
	 *transport-type*
	 
	 any->number-if-possible

	 common:special-sort
	 keys:target-set-args

	 getenv
	 setenv
	 safe-setenv

	 commonmod:get-cpu-load

	 get-area-path-signature
	 common:simple-file-lock
	 common:low-noise-print
	 common:get-create-writeable-dir
	 common:real-path
	 val->alist

	 client:get-signature

	 common:get-color-from-status
	 
	 seconds->year-work-week/day-time
	 common:simple-file-release-lock
	 common:simple-file-lock-and-wait
	 tests:lookup-itemmap

	 tests:match->sqlqry
	 runs:get-std-run-fields
	 common:min-max
	 common:max
	 common:sum
	 keys:target->keyval
	 db:patt->like

	 rmt:transport-mode
	 common:version-signature

	 keys->keystr
	 keys:config-get-fields
	 common:make-tmpdir-name

	 db:test-get-status
	 db:test-get-state
	 db:test-get-event_time
	 db:test-get-item-path
	 db:test-get-testname
	 db:test-get-id
	 db:test-get-comment
	 db:test-get-run_duration
	 db:test-get-rundir

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

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

	 tdb:step-get-comment
	 seconds->hr-min-sec
	 any->number
	 tdb:step-get-logfile
	 tdb:step-get-event_time
	 tdb:step-get-status
	 tdb:step-get-state
	 tdb:step-get-id
	 tdb:step-get-stepname
	 db:test-make-full-name
	 common:htree->html
	 common:list->htree

	 tdb:steps-table-get-log-file
	 tdb:steps-table-get-runtime
	 tdb:steps-table-get-status
	 tdb:steps-table-get-end
	 tdb:steps-table-get-start
	 tdb:steps-table-get-stepname
	 tdb:step-get-last_update
	 tdb:step-get-test_id

	 db:test-get-run_id
	 db:test-get-final_logf

	 tests:testqueue-get-item_path
	 tests:testqueue-get-itemdat
	 tests:testqueue-get-testname
	 tests:testqueue-get-priority
	 tests:testqueue-set-priority!
	 tests:testqueue-get-testconfig
	 tests:testqueue-get-waitons

	 tasks:wait-on-journal
	 common:get-area-path-signature

	 db:test-get-last_update
	 db:test-get-archived
	 db:test-get-uname
	 db:test-get-diskfree
	 db:test-get-cpuload
	 db:test-get-process_id
	 db:test-get-host
	 db:test-data-get-last_update
	 db:test-data-get-type
	 db:test-data-get-status
	 db:test-data-get-comment
	 db:test-data-get-units
	 db:test-data-get-tol
	 db:test-data-get-expected
	 db:test-data-get-value
	 db:test-data-get-variable
	 db:test-data-get-category
	 db:test-data-get-test_id
	 db:test-data-get-id

	 host-last-cpuload
	 host-last-update
	 host-last-cpuload-set!
	 host-last-update-set!
	 host-reachable-set!
	 make-host
	 host-last-used-set!
	 host-reachable
	 host-last-used

	 common:alist-ref/default
	 common:val->alist
	 common:in-running-test?
	 
	 common:without-vars
	 common:get-megatest-exe-path
	 common:get-megatest-exe-dir
	 common:get-param-mapping
	 common:get-mtexe
	 
	 db:test-get-is-toplevel
	 seconds->quarter
	 *globalexitstatus*

	 tests:testqueue-set-items!
	 tests:testqueue-get-items
	 *runconfigdat*
	 *passnum*
	 *already-seen-runconfig-info*
	 common:directory-writable?
	 common:dir-clean-up
	 common:fail-safe
	 common:list-or-null
	 *toptest-paths*
	 common:directory-exists?
	 *configstatus*
	 *last-launch*
	 *launch-setup-mutex*
	 commonmod:is-test-alive
	 alist->env-vars
	 *env-vars-by-run-id*
	 common:get-signature
	 common:join-backgrounded-threads
	 tests:glob-like-match
	 common:send-thunk-to-background-thread
	 db:test-get-fullname
	 common:clear-caches
	 db:mintest-get-event_time
	 *test-meta-updated*
	 tests:testqueue-set-item_path!
	 tests:testqueue-set-itemdat!
	 make-tests:testqueue

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

	  srfi-1
	  srfi-18
	  srfi-69
	  typed-records
	  system-information

	  debugprint
	  megatest-fossil-hash
	  
  )))

;;======================================================================
;; CONTENTS
;;
;;  config file utils
;;  misc conversion, data manipulation functions

(define (common:get-fields cfgdat)
  (let ((fields (hash-table-ref/default cfgdat "fields" '())))
    (map car fields)))

(define keys:config-get-fields common:get-fields)

;;======================================================================
;; db_records.scm
;;======================================================================

;;======================================================================
;; dbstruct
;;======================================================================

(define (make-db:test)(make-vector 20))
(define (db:test-get-id           vec) (vector-ref vec 0))
(define (db:test-get-run_id       vec) (vector-ref vec 1))
(define (db:test-get-testname     vec) (vector-ref vec 2))
(define (db:test-get-state        vec) (vector-ref vec 3))
(define (db:test-get-status       vec) (vector-ref vec 4))
(define (db:test-get-event_time   vec) (vector-ref vec 5))
(define (db:test-get-host         vec) (vector-ref vec 6))
(define (db:test-get-cpuload      vec) (vector-ref vec 7))
(define (db:test-get-diskfree     vec) (vector-ref vec 8))
(define (db:test-get-uname        vec) (vector-ref vec 9))
;; (define (db:test-get-rundir       vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define (db:test-get-rundir       vec) (vector-ref vec 10))
(define (db:test-get-item-path    vec) (vector-ref vec 11))
(define (db:test-get-run_duration vec) (vector-ref vec 12))
(define (db:test-get-final_logf   vec) (vector-ref vec 13))
(define (db:test-get-comment      vec) (vector-ref vec 14))
(define (db:test-get-process_id   vec) (vector-ref vec 16))
(define (db:test-get-archived     vec) (vector-ref vec 17))
(define (db:test-get-last_update     vec) (vector-ref vec 18))

;; (define (db:test-get-pass_count   vec) (vector-ref vec 15))
;; (define (db:test-get-fail_count   vec) (vector-ref vec 16))
(define (db:test-get-fullname     vec)
  (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))

;; replace runs:make-full-test-name with this routine
(define (db:test-make-full-name testname itempath)
  (if (equal? itempath "") testname (conc testname "/" itempath)))

;; (define (db:test-get-first_err    vec) (printable (vector-ref vec 15)))
;; (define (db:test-get-first_warn   vec) (printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated

(define (db:test-set-cpuload!  vec val)(vector-set! vec 7 val))
(define (db:test-set-diskfree! vec val)(vector-set! vec 8 val))
(define (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define (db:test-set-state!    vec val)(vector-set! vec 3 val))
(define (db:test-set-status!   vec val)(vector-set! vec 4 val))
(define (db:test-set-run_duration! vec val)(vector-set! vec 12 val))
(define (db:test-set-final_logf! vec val)(vector-set! vec 13 val))

;; Test record utility functions

;; Is a test a toplevel?
;;
(define (db:test-get-is-toplevel vec)
  (and (equal? (db:test-get-item-path vec) "")      ;; test is not an item
       (equal? (db:test-get-uname vec)     "n/a"))) ;; test has never been run

;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;; RADT => purpose of mintest??
;;
(define (make-db:mintest)(make-vector 7))
(define (db:mintest-get-id           vec)    (vector-ref  vec 0))
(define (db:mintest-get-run_id       vec)    (vector-ref  vec 1))
(define (db:mintest-get-testname     vec)    (vector-ref  vec 2))
(define (db:mintest-get-state        vec)    (vector-ref  vec 3))
(define (db:mintest-get-status       vec)    (vector-ref  vec 4))
(define (db:mintest-get-event_time   vec)    (vector-ref  vec 5))
(define (db:mintest-get-item_path    vec)    (vector-ref  vec 6))

;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define (db:testmeta-get-id            vec)    (vector-ref  vec 0))
(define (db:testmeta-get-testname      vec)    (vector-ref  vec 1))
(define (db:testmeta-get-author        vec)    (vector-ref  vec 2))
(define (db:testmeta-get-owner         vec)    (vector-ref  vec 3))
(define (db:testmeta-get-description   vec)    (vector-ref  vec 4))
(define (db:testmeta-get-reviewed      vec)    (vector-ref  vec 5))
(define (db:testmeta-get-iterated      vec)    (vector-ref  vec 6))
(define (db:testmeta-get-avg_runtime   vec)    (vector-ref  vec 7))
(define (db:testmeta-get-avg_disk      vec)    (vector-ref  vec 8))
(define (db:testmeta-get-tags          vec)    (vector-ref  vec 9))
(define (db:testmeta-set-id!           vec val)(vector-set! vec 0 val))
(define (db:testmeta-set-testname!     vec val)(vector-set! vec 1 val))
(define (db:testmeta-set-author!       vec val)(vector-set! vec 2 val))
(define (db:testmeta-set-owner!        vec val)(vector-set! vec 3 val))
(define (db:testmeta-set-description!  vec val)(vector-set! vec 4 val))
(define (db:testmeta-set-reviewed!     vec val)(vector-set! vec 5 val))
(define (db:testmeta-set-iterated!     vec val)(vector-set! vec 6 val))
(define (db:testmeta-set-avg_runtime!  vec val)(vector-set! vec 7 val))
(define (db:testmeta-set-avg_disk!     vec val)(vector-set! vec 8 val))

;;======================================================================
;; S I M P L E   R U N
;;======================================================================

;; (defstruct id  "runname" "state" "status" "owner" "event_time"

;;======================================================================
;; T E S T   D A T A 
;;======================================================================
(define (make-db:test-data)(make-vector 10))
(define (db:test-data-get-id               vec)    (vector-ref  vec 0))
(define (db:test-data-get-test_id          vec)    (vector-ref  vec 1))
(define (db:test-data-get-category         vec)    (vector-ref  vec 2))
(define (db:test-data-get-variable         vec)    (vector-ref  vec 3))
(define (db:test-data-get-value            vec)    (vector-ref  vec 4))
(define (db:test-data-get-expected         vec)    (vector-ref  vec 5))
(define (db:test-data-get-tol              vec)    (vector-ref  vec 6))
(define (db:test-data-get-units            vec)    (vector-ref  vec 7))
(define (db:test-data-get-comment          vec)    (vector-ref  vec 8))
(define (db:test-data-get-status           vec)    (vector-ref  vec 9))
(define (db:test-data-get-type             vec)    (vector-ref  vec 10))
(define (db:test-data-get-last_update      vec)    (vector-ref  vec 11))

(define (db:test-data-set-id!              vec val)(vector-set!  vec 0  val))
(define (db:test-data-set-test_id!         vec val)(vector-set!  vec 1  val))
(define (db:test-data-set-category!        vec val)(vector-set!  vec 2  val))
(define (db:test-data-set-variable!        vec val)(vector-set!  vec 3  val))
(define (db:test-data-set-value!           vec val)(vector-set!  vec 4  val))
(define (db:test-data-set-expected!        vec val)(vector-set!  vec 5  val))
(define (db:test-data-set-tol!             vec val)(vector-set!  vec 6  val))
(define (db:test-data-set-units!           vec val)(vector-set!  vec 7  val))
(define (db:test-data-set-comment!         vec val)(vector-set!  vec 8  val))
(define (db:test-data-set-status!          vec val)(vector-set!  vec 9  val))
(define (db:test-data-set-type!            vec val)(vector-set!  vec 10 val))

;;======================================================================
;; S T E P S 
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time    
(define (make-db:step)(make-vector 9))
(define (tdb:step-get-id              vec)    (vector-ref  vec 0))
(define (tdb:step-get-test_id         vec)    (vector-ref  vec 1))
(define (tdb:step-get-stepname        vec)    (vector-ref  vec 2))
(define (tdb:step-get-state           vec)    (vector-ref  vec 3))
(define (tdb:step-get-status          vec)    (vector-ref  vec 4))
(define (tdb:step-get-event_time      vec)    (vector-ref  vec 5))
(define (tdb:step-get-logfile         vec)    (vector-ref  vec 6))
(define (tdb:step-get-comment         vec)    (vector-ref  vec 7))
(define (tdb:step-get-last_update     vec)    (vector-ref  vec 8))
(define (tdb:step-set-id!             vec val)(vector-set! vec 0 val))
(define (tdb:step-set-test_id!        vec val)(vector-set! vec 1 val))
(define (tdb:step-set-stepname!       vec val)(vector-set! vec 2 val))
(define (tdb:step-set-state!          vec val)(vector-set! vec 3 val))
(define (tdb:step-set-status!         vec val)(vector-set! vec 4 val))
(define (tdb:step-set-event_time!     vec val)(vector-set! vec 5 val))
(define (tdb:step-set-logfile!        vec val)(vector-set! vec 6 val))
(define (tdb:step-set-comment!        vec val)(vector-set! vec 7 val))


;; The steps table
(define (make-db:steps-table)(make-vector 5))
(define (tdb:steps-table-get-stepname   vec)    (vector-ref  vec 0))
(define (tdb:steps-table-get-start      vec)    (vector-ref  vec 1))
(define (tdb:steps-table-get-end        vec)    (vector-ref  vec 2))
(define (tdb:steps-table-get-status     vec)    (vector-ref  vec 3))
(define (tdb:steps-table-get-runtime    vec)    (vector-ref  vec 4))
(define (tdb:steps-table-get-log-file   vec)    (vector-ref  vec 5))

(define (tdb:step-stable-set-stepname!  vec val)(vector-set! vec 0 val))
(define (tdb:step-stable-set-start!     vec val)(vector-set! vec 1 val))
(define (tdb:step-stable-set-end!       vec val)(vector-set! vec 2 val))
(define (tdb:step-stable-set-status!    vec val)(vector-set! vec 3 val))
(define (tdb:step-stable-set-runtime!   vec val)(vector-set! vec 4 val))

;; ;; The data structure for handing off requests via wire
;; (define (make-cdb:packet)(make-vector 6))
;; (define (cdb:packet-get-client-sig   vec)    (vector-ref  vec 0))
;; (define (cdb:packet-get-qtype        vec)    (vector-ref  vec 1))
;; (define (cdb:packet-get-immediate    vec)    (vector-ref  vec 2))
;; (define (cdb:packet-get-query-sig    vec)    (vector-ref  vec 3))
;; (define (cdb:packet-get-params       vec)    (vector-ref  vec 4))
;; (define (cdb:packet-get-qtime        vec)    (vector-ref  vec 5))
;; (define (cdb:packet-set-client-sig!  vec val)(vector-set! vec 0 val))
;; (define (cdb:packet-set-qtype!       vec val)(vector-set! vec 1 val))
;; (define (cdb:packet-set-immediate!   vec val)(vector-set! vec 2 val))
;; (define (cdb:packet-set-query-sig!   vec val)(vector-set! vec 3 val))
;; (define (cdb:packet-set-params!      vec val)(vector-set! vec 4 val))
;; (define (cdb:packet-set-qtime!       vec val)(vector-set! vec 5 val))

;;======================================================================
;; key_records
;;======================================================================

(define (keys->valslots keys) ;; => ?,?,? ....
  (string-intersperse (map (lambda (x) "?") keys) ","))

;; (define (keys->key/field keys . additional)
;;   (string-join (map (lambda (k)(conc k " TEXT"))
;; 		    (append keys additional)) ","))

(define (item-list->path itemdat)
  (if (list? itemdat)
      (string-intersperse  (map cadr itemdat) "/")
      ""))


;;======================================================================
;; test_records
;;======================================================================

;; make-vector-record tests testqueue testname testconfig waitons priority items
(define (make-tests:testqueue)(make-vector 7 #f))
(define (tests:testqueue-get-testname     vec)    (vector-ref  vec 0))
(define (tests:testqueue-get-testconfig   vec)    (vector-ref  vec 1))
(define (tests:testqueue-get-waitons      vec)    (vector-ref  vec 2))
(define (tests:testqueue-get-priority     vec)    (vector-ref  vec 3))
;; items: #f=no items, list=list of items remaining, proc=need to call to get items
(define (tests:testqueue-get-items        vec)    (vector-ref  vec 4))
(define (tests:testqueue-get-itemdat      vec)    (vector-ref  vec 5))
(define (tests:testqueue-get-item_path    vec)    (vector-ref  vec 6))

(define (tests:testqueue-set-testname!    vec val)(vector-set! vec 0 val))
(define (tests:testqueue-set-testconfig!  vec val)(vector-set! vec 1 val))
(define (tests:testqueue-set-waitons!     vec val)(vector-set! vec 2 val))
(define (tests:testqueue-set-priority!    vec val)(vector-set! vec 3 val))
(define (tests:testqueue-set-items!       vec val)(vector-set! vec 4 val))
(define (tests:testqueue-set-itemdat!     vec val)(vector-set! vec 5 val))
(define (tests:testqueue-set-item_path!   vec val)(vector-set! vec 6 val))


)

(module configfmod
	(
	 lookup
	 configf:lookup
	 get-section
	 configf:get-section
	 configf:lookup-number
	 read-config
	 runconfigs-get
	 configf:section-vars
	 configf:read-alist
	 configf:config->alist
	 configf:alist->config
	 configf:set-section-var

	 find-and-read-config
	 common:args-get-target
	)

(import scheme
        chicken
	extras
	files
	matchable
	ports

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

;; set some parameters here - these need to be put in something that can be loaded from other
;; executables such as dashboard and mtutil
;;
(include "dashboard-transport-mode.scm")

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     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 (uses commonmod))
(declare (uses configfmod))
(declare (uses debugprint))
(declare (uses mtargs))
(declare (uses mtmod))

(module dbmod
	(
	 db:test-get-event_time
	 db:test-get-item-path
	 db:test-get-testname
	 db:get-value-by-header
	 
	 db:get-subdb

	 db:multi-db-sync
	 
	 dbmod:open-dbmoddb
	 dbmod:run-id->dbfname

	 db:roll-up-rules
	 db:get-all-state-status-counts-for-test
	 db:test-set-state-status-db
	 db:general-call
	 db:convert-test-itempath

	 db:test-data-rollup
	 db:keep-trying-until-true
	 db:get-test-info-by-id
	 db:with-db
	 db:get-test-id
	 db:get-test-info

	 dbmod:print-db-stats
	 db:get-keys
	 db:open-no-sync-db
	 db:add-stats

	 ;; dbr:counts record accessors
	 dbr:counts->alist

	 db:add-var
	 db:archive-register-block-name
	 db:archive-register-disk
	 db:create-all-triggers
	 db:csv->test-data
	 db:dec-var
	 db:del-var
	 db:delete-old-deleted-test-records
	 db:delete-run
	 db:delete-steps-for-test!
	 db:delete-test-records
	 db:drop-all-triggers
	 db:get-all-run-ids
	 db:get-all-runids
	 db:get-changed-record-ids
	 db:get-changed-record-run-ids
	 db:get-changed-record-test-ids
	 db:get-count-tests-running
	 db:get-count-tests-running-for-run-id
	 db:get-count-tests-running-for-testname
	 db:get-count-tests-running-in-jobgroup
	 db:get-data-info-by-id
	 db:get-key-val-pairs
	 db:get-key-vals
	 db:get-latest-host-load
	 db:get-main-run-stats
	 db:get-matching-previous-test-run-records
	 db:get-not-completed-cnt
	 db:get-num-runs
	 db:get-prereqs-not-met
	 db:get-prev-run-ids
	 db:get-raw-run-stats
	 db:get-run-ids-matching-target
	 db:get-run-info
	 db:get-run-name-from-id
	 db:get-run-record-ids
	 db:get-run-state
	 db:get-run-state-status
	 db:get-run-stats
	 db:get-run-status
	 db:get-run-times
	 db:get-runs
	 db:get-runs-by-patt
	 db:get-runs-cnt-by-patt
	 db:get-steps-data
	 db:get-steps-for-test
	 db:get-steps-info-by-id
	 db:get-target
	 db:get-targets
	 db:get-test-state-status-by-id
	 db:get-test-times
	 db:get-testinfo-state-status
	 db:get-tests-for-run
	 db:get-tests-for-run-mindata
	 db:get-tests-for-run-state-status
	 db:get-tests-tags
	 db:get-toplevels-and-incompletes
	 db:get-var
	 db:have-incompletes?
	 db:inc-var
	 db:initialize-main-db
	 db:insert-run
	 db:insert-test
	 db:lock/unlock-run
	 db:login
	 db:read-test-data
	 db:read-test-data-varpatt
	 db:register-run
	 db:set-run-state-status
	 db:set-run-status
	 db:set-state-status-and-roll-up-run
	 db:set-var
	 db:simple-get-runs
	 db:test-get-archive-block-info
	 db:test-get-logfile-info
	 db:test-get-paths-matching-keynames-target-new
	 db:test-get-records-for-index-file
	 db:test-get-rundir-from-test-id
	 db:test-get-top-process-pid
	 db:test-set-archive-block-id
	 db:test-set-state-status
	 db:test-set-top-process-pid
	 db:test-toplevel-num-items
	 db:testmeta-add-record
	 db:testmeta-get-record
	 db:testmeta-update-field
	 db:teststep-set-status!
	 db:top-test-set-per-pf-counts
	 db:update-run-event_time
	 db:update-run-stats
	 db:update-tesdata-on-repilcate-db
	 tasks:add
	 tasks:find-task-queue-records
	 tasks:get-last
	 tasks:set-state-given-param-key

	 *db-stats*
	 dbmod:nfs-get-dbstruct
	 *db-stats-mutex*

	 db:get-header
	 db:get-rows
	 db:get-changed-run-ids

	 db:set-sync
	 db:setup

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

(declare (uses commonmod))
(declare (uses processmod))

(use srfi-69)

(module fsmod
	(
	 get-df
	 get-uname
	 common:get-disk-with-most-free-space
	 common:get-disk-space-used
	 common:check-db-dir-and-exit-if-insufficient

	 )

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

;;     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 (uses runsmod))
(declare (uses fsmod))

(use srfi-69)

(module launchmod
	(
	rmt:find-and-mark-incomplete
	)

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

;;     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/>.
;;

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

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

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

(declare (uses servermod))
(declare (uses fsmod))

(use srfi-69)

(module megatestmod
	(
	db:set-tests-state-status
	db:set-state-status-and-roll-up-items
	common:get-install-area
	tests:get-all
	common:use-cache?

mt:lazy-read-test-config
common:get-full-test-name
tests:extend-test-patts
tests:get-itemmaps
tests:get-items
tests:get-global-waitons
tests:get-tests-search-path
tests:filter-test-names
common:args-get-testpatt
tests:filter-test-names-not-matched
common:args-get-runname
	)

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

(declare (uses configfmod))

(import commonmod
	configfmod
	(prefix mtargs args:))

;; (use ducttape-lib)
;; (include "megatest-version.scm")
(include "megatest-fossil-hash.scm")

;; (require-library stml)

(define help (conc "
mtutil, part of the Megatest tool suite, documentation at http://www.kiatoa.com/fossils/megatest
  version " megatest-version "

(declare (uses configfmod))
;; (declare (uses tcp-transportmod)) ;; we don't want mtmod depending on tcp

(use srfi-69)

(module mtmod
	(
	 keys:make-key/field-string
	 common:get-testsuite-name
	 items:get-items-from-config
	 mt:run-trigger
	 common:get-linktree
	 common:get-area-name
	 
	 items:check-valid-items
	 mt:discard-blocked-tests

	 )

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

(declare (uses commonmod))

(use srfi-69)

(module processmod
	(
	 process:cmd-run->list
	 process:alive?
	 run-n-wait
	 process:cmd-run-with-stderr-and-exitcode->list

	 )

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

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

(module rmtmod
	(
	 rmtmod:send-receive
	 rmt:no-sync-get-lock
	 rmt:no-sync-del!
	 rmt:no-sync-set
	 rmt:no-sync-get/default

	 rmt:get-runs-by-patt
	 rmt:get-testinfo-state-status
	 rmt:get-test-id
	 rmt:set-state-status-and-roll-up-items

	 rmt:get-prereqs-not-met
	 rmt:get-tests-for-run

	 rmt:get-keys
	 rmt:test-get-records-for-index-file
	 tests:test-set-toplog!
	 rmt:test-get-logfile-info
	 rmt:general-call
	 rmt:test-get-paths-matching-keynames-target-new
	 rmt:get-test-info-by-id
	 rmt:get-steps-for-test
	 rmt:get-num-runs
	 rmt:get-runs-cnt-by-patt
	 rmt:get-runs

	 rmt:get-latest-host-load
	 rmt:get-changed-record-test-ids
	 rmt:get-all-runids
	 rmt:get-changed-record-run-ids
	 rmt:get-run-record-ids
	 rmt:get-data-info-by-id
	 rmt:get-steps-info-by-id
	 rmt:get-target

	 rmt:get-run-name-from-id
	 rmt:get-run-info
	 rmt:get-test-times
	 rmt:get-run-times

	 rmt:tasks-find-task-queue-records
	 
	 common:api-changed?
	 rmt:on-homehost?

	 rmt:get-var
	 rmt:csv->test-data
	 rmt:get-previous-test-run-record

	 common:cleanup-db
	 common:get-last-run-version

	 rmt:get-key-val-pairs
	 rmt:create-all-triggers
	 rmt:update-tesdata-on-repilcate-db
	 rmt:drop-all-triggers
	 rmt:test-get-archive-block-info
	 rmt:test-toplevel-num-items
	 rmt:archive-get-allocations
	 rmt:archive-register-disk
	 rmt:archive-register-block-name

	 mt:get-runs-by-patt
	 rmt:simple-get-runs
	 rmt:get-tests-for-runs-mindata
	 rmt:test-get-top-process-pid
	 rmt:set-state-status-and-roll-up-run
	 rmt:get-run-state-status
	 rmt:get-not-completed-cnt
	 rmt:get-tests-tags
	 rmt:testmeta-update-field
	 rmt:testmeta-add-record
	 rmt:testmeta-get-record
	 rmt:lock/unlock-run
	 rmt:delete-old-deleted-test-records
	 rmt:delete-run
	 rmt:get-raw-run-stats
	 rmt:update-run-stats
	 rmt:delete-test-records
	 rmt:test-set-archive-block-id
	 mt:get-tests-for-run
	 mt:test-set-state-status-by-testname
	 mt:test-set-state-status-by-testname-unless-completed
	 rmt:register-test
	 mt:test-set-state-status-by-id-unless-completed
	 rmt:get-all-run-ids

	 rmt:set-run-state-status
	 rmt:set-var
	 rmt:set-tests-state-status
	 rmt:tasks-add
	 rmt:tasks-set-state-given-param-key
	 rmt:register-run
	 rmt:get-count-tests-running-in-jobgroup
	 rmt:get-count-tests-running-for-run-id
	 
	 rmt:test-set-state-status-by-id
	 mt:test-set-state-status-by-id
	 )
	
	
(import scheme
	chicken
	data-structures
	regex
	extras
	matchable

(define (rmt:update-run-event_time run-id)
  (assert (number? run-id) "FATAL: Run id required.")
  (rmt:send-receive 'update-run-event_time #f (list run-id)))

(define (rmt:get-runs-by-patt  keys runnamepatt targpatt offset limit fields last-runs-update  #!key  (sort-order "asc")) ;; fields of #f uses default
  (rmt:send-receive 'get-runs-by-patt #f (list keys runnamepatt targpatt offset limit fields last-runs-update sort-order)))

;; (define (rmt:find-and-mark-incomplete run-id ovr-deadtime)
;;   (assert (number? run-id) "FATAL: Run id required.")
;;   ;; (if (rmt:send-receive 'have-incompletes? run-id (list run-id ovr-deadtime))
;;   (rmt:send-receive 'mark-incomplete run-id (list run-id ovr-deadtime))) ;; )

(define (rmt:get-main-run-stats run-id)
  (assert (number? run-id) "FATAL: Run id required.")
  (rmt:send-receive 'get-main-run-stats #f (list run-id)))

(define (rmt:get-var varname)
  (rmt:send-receive 'get-var #f (list varname)))

  (rmt:send-receive 'add-var #f (list varname value)))

;;======================================================================
;; M U L T I R U N   Q U E R I E S
;;======================================================================

;; Need to move this to multi-run section and make associated changes
;; (define (rmt:find-and-mark-incomplete-all-runs #!key (ovr-deadtime #f))
;;   (let ((run-ids (rmt:get-all-run-ids)))
;;     (for-each (lambda (run-id)
;; 	       (rmt:find-and-mark-incomplete run-id ovr-deadtime))
;; 	     run-ids)))

;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
;; 
;; Run this at the client end since we have to connect to multiple run-id dbs
;;
(define (rmt:get-previous-test-run-record run-id test-name item-path)

(declare (uses configfmod))
(declare (uses mtmod))
(declare (uses debugprint))
(declare (uses mtargs))

(module servermod
	(
	 remote-hh-dat
	 server:mk-signature
	 common:wait-for-normalized-load
	 
	 )

(import scheme
	chicken)
	
(use (srfi 18) extras s11n)
(use srfi-1 posix regex regex-case srfi-69 hostinfo md5 message-digest)

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

(use srfi-69)

(module subrunmod
	(
	 subrun:set-state-status
	 subrun:kill-subrun
	 subrun:get-log-path
	 subrun:remove-subrun
	 subrun:subrun-removed?
	 subrun:subrun-test-initialized?
	 )

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

(declare (uses mtmod))
(declare (uses megatestmod))

(use srfi-69)

(module tasksmod
	(
	 configf:write-alist
	 common:simple-unlock
	 common:simple-lock
	 tests:test-set-status!
	 common:get-launcher
	 tasks:kill-runner
	 tests:get-testconfig
	 tests:get-waitons

	 )

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

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

(import commonmod
	rmtmod
	(prefix mtargs args:))

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

(define origargs (cdr (argv)))
(define remargs (args:get-args
		 (argv)
		 `( "-target"

(declare (uses portlogger))
(declare (uses mtmod))

(use address-info tcp)

(module tcp-transportmod
	(
	 tt:mk-signature
	 tt-state
	 tt:server-process-run
	 tt:make-remote
	 tt-ro-mode-checked-set!
	 tt-ro-mode-set!
	 tt-ro-mode
	 tt-ro-mode-checked
	 tt:handler
	 tt:get-conn
	 )
	
(import scheme)

(cond-expand
 (chicken-4
  (import (prefix sqlite3 sqlite3:)

;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
;;     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 (uses fsmod))

(use srfi-69)

(module testsmod
	(
	 tests:summarize-items
	 tests:filter-non-runnable
	 tests:sort-by-priority-and-waiton

	 )

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

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

(import (prefix mtargs args:)
	debugprint)

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

;;======================================================================
;; T R E E   S T U F F 
;;======================================================================