19
20
21
22
23
24
25
26
27
28
29
30
31
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
(case (string->symbol cmd)
;; KEYS
((get-key-val-pairs) (apply db:get-key-val-pairs db params))
((get-keys) (db:get-keys db))
;; TESTS
;; json doesn't do vectors, convert to list
((get-test-info-by-id) (let ((res (apply db:get-test-info-by-id db params)))
(if (vector? res)(vector->list res) res)))
((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params))
((test-set-state-status-by-id) (apply db:test-set-state-status-by-id db params))
((get-count-tests-running) (db:get-count-tests-running db))
((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup db params))
((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) (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))
((update-fail-pass-counts) (apply db:general-call db 'update-pass-fail-counts params))
((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id db params))
;; RUNS
((get-run-info) (let ((res (apply db:get-run-info db params)))
(list (vector-ref res 0)
(vector->list (vector-ref res 1)))))
((register-run) (apply db:register-run db params))
((set-tests-state-status) (apply db:set-tests-state-status db params))
((get-tests-for-run) (let ((res (apply db:get-tests-for-run db params)))
(if (list? res)
(map (lambda (x)
(if (list? x)
(vector->list x)
(begin
(debug:print 0 "ERROR in remote of get-tests-for-run, not a vector")
x)))
res)
(begin
(debug:print 0 "ERROR in remote of get-tests-for-run, not a list")
res))))
((get-test-id) (apply db:get-test-id-not-cached db params))
((get-tests-for-runs-mindata) (map vector->list (apply db:get-tests-for-runs-mindata db params)))
((get-run-name-from-id) (apply db:get-run-name-from-id db params))
((delete-run) (apply db:delete-run db params))
((get-runs) (let* ((res (apply db:get-runs db params))
(hedr (vector-ref res 0))
(data (vector-ref res 1)))
(list hedr (map vector->list data))))
((get-runs-by-patt) (let* ((res (apply db:get-runs-by-patt db params))
(hedr (vector-ref res 0))
(data (vector-ref res 1)))
(list hedr (map vector->list data))))
((lock/unlock-run) (apply db:lock/unlock-run db params))
((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)))
|
|
<
|
|
<
<
<
|
<
<
<
<
<
|
<
<
|
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
|
<
<
<
|
19
20
21
22
23
24
25
26
27
28
29
30
31
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
59
60
61
62
|
(case (string->symbol cmd)
;; KEYS
((get-key-val-pairs) (apply db:get-key-val-pairs db params))
((get-keys) (db:get-keys db))
;; TESTS
;; json doesn't do vectors, convert to list
((get-test-info-by-id) (apply db:get-test-info-by-id db params))
((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params))
((test-set-state-status-by-id) (apply db:test-set-state-status-by-id db params))
((get-count-tests-running) (db:get-count-tests-running db))
((get-count-tests-running-in-jobgroup) (apply db:get-count-tests-running-in-jobgroup db params))
((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)(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))
((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new db params))
((get-prereqs-not-met) (apply db:get-prereqs-not-met db params))
((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts db params))
((update-fail-pass-counts) (apply db:general-call db 'update-pass-fail-counts params))
((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id db params))
;; RUNS
((get-run-info) (apply db:get-run-info db params))
((register-run) (apply db:register-run db params))
((set-tests-state-status) (apply db:set-tests-state-status db params))
((get-tests-for-run) (apply db:get-tests-for-run db params))
((get-test-id) (apply db:get-test-id-not-cached db params))
((get-tests-for-runs-mindata) (apply db:get-tests-for-runs-mindata db params))
((get-run-name-from-id) (apply db:get-run-name-from-id db params))
((delete-run) (apply db:delete-run db params))
((get-runs) (apply db:get-runs db params))
((get-runs-by-patt) (apply db:get-runs-by-patt db params))
((lock/unlock-run) (apply db:lock/unlock-run db params))
((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)))
|
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(thread-sleep! 3)
(if pid
(process-signal pid signal/kill)
(thread-start! th1))
'(#t "exit process started")))
;; TESTMETA
((testmeta-get-record) (let ((res (apply db:testmeta-get-record db params)))
(if (vector? res)
(vector->list res)
res)))
((testmeta-add-record) (apply db:testmeta-add-record db params))
((testmeta-update-field) (apply db:testmeta-update-field db params))
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
|
|
<
<
<
|
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
(thread-sleep! 3)
(if pid
(process-signal pid signal/kill)
(thread-start! th1))
'(#t "exit process started")))
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record db params))
((testmeta-add-record) (apply db:testmeta-add-record db params))
((testmeta-update-field) (apply db:testmeta-update-field db params))
(else
(list "ERROR" 0))))
;; http-server send-response
;; api:process-request
|