Megatest

;;

(declare (uses dbi))
(declare (uses pkts))
(declare (uses stml2))
(declare (uses cookie))
(declare (uses csv-xml))
(declare (uses hostinfo))
;; (declare (uses hostinfo))

(declare (uses adjutant))
(declare (uses archivemod))
(declare (uses apimod))
(declare (uses autoload))
(declare (uses bigmod))
(declare (uses commonmod))

(declare (uses mtver))
(declare (uses mutils))
(declare (uses processmod))
(declare (uses rmtmod))
(declare (uses runsmod))
(declare (uses servermod))
(declare (uses testsmod))
(declare (uses dbmgrmod))

;; needed for configf scripts, scheme etc.
;; (declare (uses apimod.import))
;; (declare (uses debugprint.import))
;; (declare (uses mtargs.import))
;; (declare (uses commonmod.import))
;; (declare (uses configfmod.import))
;; (declare (uses bigmod.import))
;; (declare (uses dbmod.import))
;; (declare (uses rmtmod.import))
;; (declare (uses servermod.import))
;; (declare (uses launchmod.import))

;; (include "call-with-environment-variables/call-with-environment-variables.scm")

(module megatest-main
(module megatest
	*

  (import scheme
	  chicken.base
	  chicken.bitwise
	  chicken.condition
	  ;; chicken.csi

	  srfi-98
	  srfi-69

	  ;; local modules
	  autoload
	  adjutant
	  csv-xml
	  hostinfo
	  ;; hostinfo
	  mtver
	  mutils
	  cookie
	  csv-xml
	  ducttape-lib
	  (prefix mtargs args:)
	  pkts

	  launchmod
	  processmod
	  rmtmod
	  runsmod
	  servermod
	  tasksmod
	  testsmod
	  dbmgrmod
	  
	  ulex
	  )
	

;;   ;; ulex parameters
;;   (work-method 'direct)
;;   (return-method 'direct)
  
  ;; ulex parameters
  ;; (work-method   'mailbox)
  ;; (return-method 'mailbox)

(my-with-lock common:with-simple-file-lock)
  
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)

(define *didsomething* #f)  
(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 "test_records.scm")

     			 newlogf)
     		       logpath-in)))
     (if (not (directory-exists? log-dir))
	 (system (conc "mkdir -p " log-dir)))
     (open-output-file logpath))
   (exn ()
	(debug:print-error 0 *default-log-port* "Could not open log file for write: "logpath-in)
	(define *didsomething* #t)  
	(set! *didsomething* #t)
	(exit 1))))

;; Disabled help items
;;  -rollup                 : (currently disabled) fill run (set by :runname)  with latest test(s)
;;                            from prior runs with same keys
;;  -daemonize              : fork into background and disconnect from stdin/out

Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))
     
(define (main)
  (make-and-init-bigdata)

  
  ;; set up the functions in http transport
  (hash-table-set! *http-functions* 'api:process-request          api:process-request)
  (hash-table-set! *http-functions* 'http-transport:main-page     http-transport:main-page)
  (hash-table-set! *http-functions* 'http-transport:show-jquery   http-transport:show-jquery)
  (hash-table-set! *http-functions* 'http-transport:html-test-log http-transport:html-test-log)
  (hash-table-set! *http-functions* 'http-transport:html-dboard   http-transport:html-dboard)
  
;; 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")))
  (if (common:file-exists? debugcontrolf)
      (load debugcontrolf)))

;; usage logging, careful with this, it is not designed to deal with all real world challenges!

     	(begin
     	  (debug:print-error 0 *default-log-port* "non-existant start dir " (args:get-arg "-start-dir") " specified, exiting.")
     	  (exit 1))))
     
     ;; immediately set MT_TARGET if -reqtarg or -target are available
     ;;
     (let ((targ (or (args:get-arg "-reqtarg")(args:get-arg "-target"))))
       (if targ 
        (begin
       (if targ (set-environment-variable! "MT_TARGET" targ)))
          (set-environment-variable! "MT_TARGET" targ)
          (mytarget targ)
        )
        )
       )
     
     ;; The watchdog is to keep an eye on things like db sync etc.
     ;;
;; (init-watchdog)
  
;;      (define (debug:debug-mode n)
;;        (cond

           (exit)))
     
     (if (args:get-arg "-version")
         (begin
           (print (common:version-signature)) ;; (print megatest-version)
           (exit)))
     
     (define *didsomething* #f)
     
     ;; Overall exit handling setup immediately
     ;;
     (if (or (args:get-arg "-process-reap"))
             ;; (args:get-arg "-runtests")
     	;; (args:get-arg "-execute")
     	;; (args:get-arg "-remove-runs")
     	;; (args:get-arg "-runstep"))

     				       sheetname sectionname varname val)))
     		   (sqlite3:finalize! db)))
     		(else
     		 (pp data))))))
           (if out-file (close-output-port out-port))
           (exit) ;; yes, bending the rules here - need to exit since this is a utility
           ))
     
     (if (args:get-arg "-ping")

  ;; disabled for now
  
     #;(if (args:get-arg "-ping")
         (let* ((server-id     (string->number (args:get-arg "-ping"))) ;; extract run-id (i.e. no ":"
     	   (host:port     (args:get-arg "-ping")))
           (server:ping (or server-id host:port) #f do-exit: #t)))
           (server-ready? (or server-id host:port) #f do-exit: #t)))
     
     ;;======================================================================
     ;; Capture, save and manipulate environments
     ;;======================================================================
     
     ;; NOTE: Keep these above the section where the server or client code is setup
     

         (bdat-time-to-exit-set! *bdat* #t)
         )
     ;;(debug:print-info 13 *default-log-port* "thread-join! watchdog")
     
     ;; join the watchdog thread if it has been thread-start!ed  (it may not have been started in the case of a server that never enters running state)
     ;;   (symbols returned by thread-state: created ready running blocked suspended sleeping terminated dead)
     ;; TODO: for multiple areas, we will have multiple watchdogs; and multiple threads to manage
     (let* ((watchdog (bdat-watchdog *bdat*)))
     #;(let* ((watchdog (bdat-watchdog *bdat*)))
       (if (thread? watchdog)
	   (case (thread-state watchdog)
	     ((ready running blocked sleeping terminated dead)
	      (thread-join! watchdog)))))
     
     (bdat-time-to-exit-set! *bdat* #t)
     
     (if (not (eq? *globalexitstatus* 0))
         (if (or (args:get-arg "-run")(args:get-arg "-runtests")(args:get-arg "-runall"))
             (begin
	       (debug:print 0 *default-log-port* "NOTE: Subprocesses with non-zero exit code detected: " *globalexitstatus*)
	       (exit 0))
             (case *globalexitstatus*
	       ((0)(exit 0))
	       ((1)(exit 1))
	       ((2)(exit 2))
	       (else (exit 3)))))
     )

;; (import megatest-main commonmod)
;; (import srfi-18)
)

(thread-join!
 (thread-start!
  (make-thread main)))

(import megatest-main)
(import commonmod)
(main)

)