Megatest

Diff
Login

Differences From Artifact [71251d311f]:

To Artifact [d11cee8fe2]:


56
57
58
59
60
61
62
63


64
65
66
67
68
69
70
56
57
58
59
60
61
62

63
64
65
66
67
68
69
70
71







-
+
+







;; (declare (uses mtargs.import))

;; (declare (uses ftail))
;; (import ftail)

(import dbmod
	commonmod
	dbfile)
	dbfile
	servermod)

(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")
920
921
922
923
924
925
926
927
















928
929


930
931
932
933
934
935
936
921
922
923
924
925
926
927

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944

945
946
947
948
949
950
951
952
953







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
+







;; Start the server - can be done in conjunction with -runall or -runtests (one day...)
;;   we start the server if not running else start the client thread
;;======================================================================

;; Server? Start up here.
;;
(if (args:get-arg "-server")
    (let ((tl        (launch:setup)))
    (let* ((tl        (launch:setup))
	   (srvdat    (server:setup tl))
	   (handler   (lambda (dbstruct cmd params)
			(api:execute-requests dbstruct (if (string? cmd)
							   (string->symbol cmd)
							   cmd)
					      (db:string->obj params)))))
      (server:set-handler srvdat handler)
      (srv-obj-to-str-set! srvdat db:obj->string)
      (srv-str-to-obj-set! srvdat db:string->obj)
      (srv-dbstruct-set! srvdat (db:setup #t))
      (thread-join!
       (thread-start! (make-thread
		       (lambda ()
			 (server:run srvdat)))))
      
      ;; (server:launch 0 'http)
      (http-transport:launch)
      ;; (http-transport:launch)  ;; NOTE: Need to replace this call
      
      (set! *didsomething* #t)))

;; The adjutant is a bit different, it does NOT run (launch:setup) as it is not necessarily tied to
;; a specific Megatest area. Detail are being hashed out and this may change.
;;
(if (args:get-arg "-adjutant")
    (begin