Megatest

           process.scm runs.scm tasks.scm tests.scm genexample.scm	\
           http-transport.scm filedb.scm tdb.scm client.scm mt.scm	\
           ezsteps.scm lock-queue.scm sdb.scm rmt.scm api.scm		\
           subrun.scm portlogger.scm archive.scm env.scm		\
           diff-report.scm cgisetup/models/pgdb.scm

# module source files
MSRCFILES = 
MSRCFILES = mutils.scm
# ftail.scm rmtmod.scm commonmod.scm removed
# MSRCFILES = ducttape-lib.scm pkts.scm stml2.scm cookie.scm mutils.scm	\
#             mtargs.scm commonmod.scm dbmod.scm adjutant.scm ulex.scm	\
#             rmtmod.scm apimod.scm

GUISRCF = dashboard-context-menu.scm dashboard-tests.scm		\
          dashboard-guimonitor.scm gutils.scm dcommon.scm tree.scm	\

#     Megatest is distributed in the hope that it will be useful,
#     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/>.

(server:writable-watchdog-bruteforce dbstruct)

(server:writable-watchdog-deltasync dbstruct)


=====================================================================
NOTES from looking at branch v1.62-rpc
=====================================================================

*last-db-access* or *db-last-access* ==> which is it to be?
seen in singletest: ERROR: Unrecognised arguments: :first_err This is the first error

(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 mutils))
;; (declare (uses ftail))
;; (import ftail)

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

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

(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (prefix base64 base64:)
     readline apropos json http-client directory-utils typed-records
     http-client srfi-18 extras format)

;; Added for csv stuff - will be removed
;;
(use sparse-vectors)

(import mutils)

(require-library mutils)
;;(require-library mutils)

(define *usage-log-file* #f)    ;; put path to file for logging usage in this var in the ~/.megatestrc file
(define *usage-use-seconds* #t) ;; for Epoc seconds in usage logging change this to #t in ~/.megatestrc file

;; load the ~/.megatestrc file, put (use trace)(trace-call-sites #t)(trace function-you-want-to-trace) in this file
;;
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.megatestrc")))

(define *rmt-query-last-rest-time* 0) ;; last time there was at least a 1/2 second rest - giving other processes access to the db

;; NOTE: This query rest algorythm will not adapt to long query times. REDESIGN NEEDED. TODO. FIXME.
;;
(define (rmt:query-rest cmd rid params)
  (let* ((now (current-milliseconds)))
    (cond
     ((> (- now *rmt-query-last-call-time*) 500)  ;; it's been a while since last query - no need to rest
     ((> (- now *rmt-query-last-call-time*) 100)  ;; it's been a while since last query - no need to rest
      (set! *rmt-query-last-rest-time*  now)
      (set! *rmt-query-last-call-time*  now))
     ((> (- now *rmt-query-last-rest-time*) 5000) ;; no natural rests have happened
      (debug:print 0 *default-log-port* "query rest needed. blocking for 1/2 second. cmd="cmd", run id="rid", params="params)
      (thread-sleep! 0.5) ;; force a rest of a half second
      (debug:print 0 *default-log-port* "query rest needed. blocking for 0.1 second. cmd="cmd", run id="rid", params="params)
      (thread-sleep! 0.1) ;; force a rest of a half second
      (set! *rmt-query-last-rest-time* now)
      (set! *rmt-query-last-call-time* now))
     (else ;; sufficient rests have occurred, just record the last query time
      (set! *rmt-query-last-call-time* now)))))

;; RA => e.g. usage (rmt:send-receive 'get-var #f (list varname))
;;

         (num-retries           0)
         (max-retries           (configf:lookup *configdat* "setup" "maxretries"))
         (max-concurrent-jobs   (configf:lookup-number *configdat* "setup" "max_concurrent_jobs" default: 50))
         (reglen                (if (number? reglen-in) reglen-in 1))
         (last-time-incomplete  (- (current-seconds) 900)) ;; force at least one clean up cycle
         (last-time-some-running (current-seconds))
         ;; (tdbdat                (tasks:open-db))
	 (misc-data             (make-hash-table)) ;; use as needed
         (runsdat (make-runs:dat
                   ;; hed: hed
                   ;; tal: tal
                   ;; reg: reg
                   ;; reruns: reruns
                   reglen: reglen
                   regfull: #f ;; regfull

      ;;
      (if (> (current-seconds)(+ last-time-incomplete 900))
          (begin
            (set! last-time-incomplete (current-seconds))
            ;; (rmt:find-and-mark-incomplete-all-runs)
	    ))

      ;; WAIT FOR TIME ON TIGHT LOOP
      (if (< (- (current-milliseconds)(hash-table-ref/default misc-data "tight-loop-last-time" 0))
	     100) ;; less than 1/100 second since came through the loop
	  (thread-sleep! 0.1)) ;; wait a 1/100 seconds
      (hash-table-set! misc-data "tight-loop-last-time" (current-milliseconds))
      
      ;; (print "Top of loop, hed=" hed ", tal=" tal " ,reruns=" reruns)
      (let* ((test-record (hash-table-ref test-records hed))
	     (test-name   (tests:testqueue-get-testname test-record))
	     (tconfig     (tests:testqueue-get-testconfig test-record))
	     (jobgroup    (configf:lookup tconfig "test_meta" "jobgroup"))
	     (testmode    (let ((m (configf:lookup tconfig "requirements" "mode")))
			    (if m (map string->symbol (string-split m)) '(normal))))