32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
|
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
-
+
+
+
+
+
-
+
|
((delete-test-records) (apply db:delete-test-records db params))
((delete-old-deleted-test-records) (db:delete-old-deleted-test-records db))
((test-set-status-state) (apply db:test-set-status-state db params))
((get-previous-test-run-record) (apply db:get-previous-test-run-record db params))
((get-matching-previous-test-run-records)(map vector->list (apply db:get-matching-previous-test-run-records db params)))
((db:test-get-logfile-info) (apply db:test-get-logfile-info db params))
((test-get-records-for-index-file (apply db:test-get-records-for-index-file db params)))
((get-testinfo-state-status) (apply db:get-testinfo-state-status db params))
((get-testinfo-state-status) (let ((res (apply db:get-testinfo-state-status db params)))
(if (vector? res)
(vector->list res)
res)))
((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new db params))
((get-prereqs-not-met) (let ((res (apply db:get-prereqs-not-met db params)))
(map (lambda (x)
(if (vector? x)
(vector->list x)
x))
res)))
((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts db params))
|
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
+
|
((update-run-event_time) (apply db:update-run-event_time db params))
;; MISC
((login) (apply db:login db params))
((general-call) (let ((stmtname (car params))
(realparams (cdr params)))
(db:general-call db stmtname realparams)))
((sync-inmem->db) (db:sync-back))
((kill-server)
(db:sync-to *inmemdb* *db*)
(let ((hostname (car *runremote*))
(port (cadr *runremote*))
(pid (if (null? params) #f (car params)))
(th1 (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))
(debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")
|