37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(import scheme
chicken.base
chicken.process-context.posix
chicken.string
chicken.time
chicken.condition
chicken.process
chicken.random
chicken.file
;; (prefix sqlite3 sqlite3:)
typed-records
srfi-18
srfi-69
|
>
|
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
(import scheme
chicken.base
chicken.process-context.posix
chicken.string
chicken.time
chicken.condition
chicken.process
chicken.pathname
chicken.random
chicken.file
;; (prefix sqlite3 sqlite3:)
typed-records
srfi-18
srfi-69
|
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
;; TASKS
tasks-add
tasks-set-state-given-param-key
))
(define (api:run-server-process apath dbname)
(let* ((cmd (conc "nbfake megatest -server - -area "apath
" -db "dbname))
(cleandbname (string-translate dbname "./" "_-"))
(logd (conc apath "/logs"))
(logf (conc logd "/server-"(current-seconds)cleandbname".log")))
|
>
>
>
>
>
>
>
>
|
|
<
<
<
|
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
;; TASKS
tasks-add
tasks-set-state-given-param-key
))
(define (api:run-server-process apath dbname)
(let* ((cleandbname (pathname-strip-directory dbname)) ;; (string-translate dbname "./" "--"))
(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)))
(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
|
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; SERVERS
;; ((start-server) (apply server:kind-run params))
((kill-server) (set! *server-run* #f))
((get-server) (api:start-server dbstruct params))
((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((get-count-servers) (apply db:get-count-servers dbstruct params))
;; TESTS
;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params))
;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.
((test-set-state-status-by-id)
;; (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
|
|
>
|
|
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
|
;;===============================================
((get-keys-write) (db:get-keys dbstruct)) ;; force a dummy "write" query to force server; for debug in -repl
;; SERVERS
;; ((start-server) (apply server:kind-run params))
((kill-server) (set! *server-run* #f))
((start-server get-server) (api:start-server dbstruct params))
((get-server-info) (apply db:get-server-info dbstruct params))
((register-server) (apply db:register-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((deregister-server) (apply db:deregister-server dbstruct params) );; dbstruct host port servkey pid ipaddr dbpath)
((get-count-servers) (apply db:get-count-servers dbstruct params))
((get-servers-info) (apply db:get-servers-info dbstruct params))
;; TESTS
;;((test-set-state-status-by-id) (apply mt:test-set-state-status-by-id dbstruct params))
;;BB - commented out above because it was calling below, eventually, incorrectly (dbstruct passed to mt:test-set-state-status-by-id, which previosly did more, but now only passes thru to db:set-state-status-and-roll-up-items.
((test-set-state-status-by-id)
;; (define (db:set-state-status-and-roll-up-items dbstruct run-id test-name item-path state status comment)
|
341
342
343
344
345
346
347
348
349
350
351
352
353
354
|
((get-runs-cnt-by-patt) (apply db:get-runs-cnt-by-patt dbstruct params))
((get-all-run-ids) (db:get-all-run-ids dbstruct))
((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params))
((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params))
((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params))
((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params))
((get-main-run-stats) (apply db:get-main-run-stats dbstruct params))
((get-var) (apply db:get-var dbstruct params))
((get-run-stats) (apply db:get-run-stats dbstruct params))
((get-run-times) (apply db:get-run-times dbstruct params))
;; STEPS
((get-steps-data) (apply db:get-steps-data dbstruct params))
((get-steps-for-test) (apply db:get-steps-for-test dbstruct params))
|
>
|
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
|
((get-runs-cnt-by-patt) (apply db:get-runs-cnt-by-patt dbstruct params))
((get-all-run-ids) (db:get-all-run-ids dbstruct))
((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct params))
((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct params))
((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct params))
((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct params))
((get-main-run-stats) (apply db:get-main-run-stats dbstruct params))
((log-to-main) (apply debug:print 0 *default-log-port* params))
((get-var) (apply db:get-var dbstruct params))
((get-run-stats) (apply db:get-run-stats dbstruct params))
((get-run-times) (apply db:get-run-times dbstruct params))
;; STEPS
((get-steps-data) (apply db:get-steps-data dbstruct params))
((get-steps-for-test) (apply db:get-steps-for-test dbstruct params))
|