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

	  ulex
	  )
	

;;   ;; ulex parameters
;;   (work-method 'direct)
;;   (return-method 'direct)
  
  ;; ulex parameters
  (work-method 'mailbox)
  (return-method 'mailbox)
  
;; 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!

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

)