Megatest

Diff
Login

Differences From Artifact [f47a08f057]:

To Artifact [e1bfe096ff]:


27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
27
28
29
30
31
32
33

34
35
36
37
38
39
40
41







-
+








(module apimod
  (
api:run-server-process
api:start-server
api:dispatch-cmd
api:execute-requests
api:process-request
;; api:process-request
)
	
(import scheme
	chicken.base
	chicken.process-context.posix
	chicken.string
	chicken.time
173
174
175
176
177
178
179
180
181



182
183
184
185
186
187
188
173
174
175
176
177
178
179


180
181
182
183
184
185
186
187
188
189







-
-
+
+
+







	 (logd        (conc apath "/logs")) 
	 (logf        (conc logd "/server-launch-";;(current-process-id)
			    (seconds->year-work-week/day-time-fname (current-seconds))
			    "-"cleandbname".log"))
	 (logf2       (conc logd "/server-"
			    (seconds->year-work-week/day-time-fname (current-seconds))
			    "-"cleandbname"-"))
	 (cmd  (conc "nbfake megatest -server - -area "apath
		     " -db "dbname" -autolog "logf2)))
	 (cmd  (conc "nbfake mtserver -server - -area "apath" -db "dbname)
		     ;; " -autolog "logf2 ;; the side log did not help. Ended up with two logs and the pid in the name was not that useful.
		     ))
    (if (not (directory-exists? logd))
	(create-directory logd #t))
    (system (conc "NBFAKE_LOG="logf" "cmd))))

;; special function to get server
;; look up in db
;; if found -> return it
372
373
374
375
376
377
378
379

380
381
382
383
384
385
386
373
374
375
376
377
378
379

380
381
382
383
384
385
386
387







-
+







    ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
    ((login)                        (apply db:login dbstruct params))
    ((general-call)                 (let ((stmtname   (car params))
					  (run-id     (cadr params))
					  (realparams (cddr params)))
				      (db:general-call dbstruct stmtname run-id realparams)))
    ((sdb-qry)                      (apply sdb:qry params))
    ((ping)                         (current-process-id))
    ((ping)                         `(#t ,(current-process-id) ,(cadr params))) ;; (current-process-id))
    ((get-changed-record-ids)       (apply db:get-changed-record-ids dbstruct params))
    ((get-run-record-ids) 	   (apply db:get-run-record-ids dbstruct params))	
    ;; TESTMETA
    ((testmeta-get-record)       (apply db:testmeta-get-record dbstruct params))

    ;; TASKS 
    ((find-task-queue-records)   (apply tasks:find-task-queue-records dbstruct params))
418
419
420
421
422
423
424
425

426
427
428
429
430
431
432
419
420
421
422
423
424
425

426
427
428
429
430
431
432
433







-
+








;; http-server  send-response
;;                 api:process-request
;;                    db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
#;(define (api:process-request dbstruct indat) ;; the $ is the request vars proc
  (let* ((cmd-in  (alist-ref 'cmd indat)) ;; ($ 'cmd))
	 (cmd     (if (string? cmd-in)(string->symbol cmd-in) cmd-in))
	 (params  (alist-ref 'params indat))
         (key     (alist-ref 'key indat))    ;; TODO - add this back
	 ;; (doprint (apply common:low-noise-print 10 params))
	 )
    ;; (if doprint (debug:print 0 *default-log-port* "cmd: " cmd " with params: " params ", key: " key))