53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
;; 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) (map vector->list (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) (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)))
|
|
>
>
>
>
>
>
>
>
>
>
>
|
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
|
;; 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)))
|
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request db $) ;; the $ is the request vars proc
(let* ((cmd ($ 'cmd))
(paramsj ($ 'params))
(params (rmt:json-str->dat paramsj))
(res (api:execute-requests db cmd params)))
;; This can be here but needs controls to ensure it doesn't run more than every 4 seconds
(rmt:dat->json-str
(if (or (string? res)
(list? res)
(number? res)
(boolean? res))
res
(list "ERROR" 1 cmd params res)))))
|
|
|
|
|
|
|
|
|
>
|
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
;; db:*
;;
;; NB// Runs on the server as part of the server loop
;;
(define (api:process-request db $) ;; the $ is the request vars proc
(let* ((cmd ($ 'cmd))
(paramsj ($ 'params))
(params (db:string->obj paramsj)) ;; (rmt:json-str->dat paramsj))
(res (api:execute-requests db cmd params)))
;; This can be here but needs controls to ensure it doesn't run more than every 4 seconds
;; (rmt:dat->json-str
;; (if (or (string? res)
;; (list? res)
;; (number? res)
;; (boolean? res))
;; res
;; (list "ERROR, not string, list, number or boolean" 1 cmd params res)))))
(db:obj->string res)))
|