Overview
Context
Changes
Modified db.scm
from [aabc9033ad]
to [bdd29402b8].
︙ | | |
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
+
+
-
+
|
;; (sdb:initialize db)
)) ;; add strings db to rundb, not in use yet
(sqlite3:set-busy-handler! db handler)
(sqlite3:execute db "PRAGMA synchronous = 0;")))
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'rundb db)
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inuse #t)
(if local
(begin
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inmem db) ;; direct access ...
db
db)
(begin
(dbr:dbstruct-set-runvec-val! dbstruct run-id 'inmem inmem)
(db:sync-tables db:sync-tests-only db inmem)
inmem))))))
;; This routine creates the db. It is only called if the db is not already opened
;;
|
︙ | | |
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
|
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
|
-
-
+
-
+
-
-
-
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
|
;; replace header and keystr with a call to runs:get-std-run-fields
;;
;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") )
;; runpatts: patt1,patt2 ...
;;
(define (db:get-runs dbstruct runpatt count offset keypatts)
(let* ((db (db:get-db dbstruct #f))
(res '())
(let* ((res '())
(keys (db:get-keys dbstruct))
(runpattstr (db:patt->like "runname" runpatt))
(remfields (list "id" "runname" "state" "status" "owner" "event_time"))
(header (append keys remfields))
(keystr (conc (keys->keystr keys) ","
(string-intersperse remfields ",")))
(string-intersperse remfields ",")))
(qrystr (conc "SELECT " keystr " FROM runs WHERE (" runpattstr ") " ;; runname LIKE ? "
;; Generate: " AND x LIKE 'keypatt' ..."
(if (null? keypatts) ""
(conc " AND "
;; Generate: " AND x LIKE 'keypatt' ..."
(if (null? keypatts) ""
(conc " AND "
(string-join
(map (lambda (keypatt)
(let ((key (car keypatt))
(patt (cadr keypatt)))
(db:patt->like key patt)))
keypatts)
" AND ")))
" AND state != 'deleted' ORDER BY event_time DESC "
(if (number? count)
(conc " LIMIT " count)
"")
(if (number? offset)
(conc " OFFSET " offset)
""))))
" AND state != 'deleted' ORDER BY event_time DESC "
(if (number? count)
(conc " LIMIT " count)
"")
(if (number? offset)
(conc " OFFSET " offset)
""))))
(debug:print-info 11 "db:get-runs START qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
(db:with-db dbstruct #f #f
(lambda (db)
(sqlite3:for-each-row
(lambda (a . x)
(set! res (cons (apply vector a x) res)))
db
qrystr
)
(sqlite3:for-each-row
(lambda (a . x)
(set! res (cons (apply vector a x) res)))
db
qrystr
)))
(debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count)
(vector header res)))
;; Get all targets from the db
;;
(define (db:get-targets dbstruct)
(let* ((res '())
|
︙ | | |
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
|
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
|
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
|
" ")))
(if sort-order sort-order " ")
(if limit (conc " LIMIT " limit) " ")
(if offset (conc " OFFSET " offset) " ")
";"
)))
(debug:print-info 8 "db:get-tests-for-run qry=" qry)
(db:with-db dbstruct run-id #f
(lambda (db)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
(db:get-db dbstruct run-id)
qry
run-id
)
(sqlite3:for-each-row
(lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
db
qry
run-id
)))
(case qryvals
((shortlist)(map db:test-short-record->norm res))
((#f) res)
(else res))))
(define (db:test-short-record->norm inrec)
;; "id,run_id,testname,item_path,state,status"
|
︙ | | |
Modified http-transport.scm
from [5185cc870e]
to [ac12c8febe].
︙ | | |
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
|
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
|
-
+
|
(* 3 24 60 60)))))
(debug:print-info 2 "server-timeout: " server-timeout ", server pid: " spid " on " iface ":" port)
(let loop ((count 0))
;; Use this opportunity to sync the inmemdb to db
(let ((start-time (current-milliseconds))
(sync-time #f)
(rem-time #f))
(if *inmemdb* (db:sync-touched *inmemdb*))
(if *inmemdb* (db:sync-touched *inmemdb* force-sync: #t))
(set! sync-time (- (current-milliseconds) start-time))
(set! rem-time (quotient (- 4000 sync-time) 1000))
(debug:print 0 "SYNC: time= " sync-time ", rem-time=" rem-time)
(if (and (<= rem-time 4)
(> rem-time 0))
(thread-sleep! rem-time)
(thread-sleep! 4))) ;; fallback for if the math is changed ...
|
︙ | | |
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
-
+
|
(begin
(debug:print-info 0 "Server continuing, seconds since last db access: " (- (current-seconds) last-access))
(loop 0))
(begin
(debug:print-info 0 "Starting to shutdown the server.")
;; need to delete only *my* server entry (future use)
(set! *time-to-exit* #t)
(if *inmemdb* (db:sync-touched *inmemdb*))
(if *inmemdb* (db:sync-touched *inmemdb* force-sync: #t))
(open-run-close tasks:server-deregister-self tasks:open-db (get-host-name))
(thread-sleep! 1)
(debug:print-info 0 "Max cached queries was " *max-cache-size*)
(debug:print-info 0 "Number of cached writes " *number-of-writes*)
(debug:print-info 0 "Average cached write time "
(if (eq? *number-of-writes* 0)
"n/a (no writes)"
|
︙ | | |
Modified launch.scm
from [84634528b4]
to [d84a98873c].
︙ | | |
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
|
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
|
+
-
+
|
;; NB - This is not working right - some top tests are not getting the path set!!!
(if (not (hash-table-ref/default *toptest-paths* testname #f))
(let* ((testinfo (rmt:get-test-info-by-id run-id test-id)) ;; run-id testname item-path))
(curr-test-path (if testinfo ;; (filedb:get-path *fdb*
;; (db:get-path dbstruct
;; (rmt:sdb-qry 'getstr
(rmt:sdb-qry 'getstr (db:test-get-rundir testinfo)) ;; )
(db:test-get-rundir testinfo) ;; ) ;; )
#f)))
(hash-table-set! *toptest-paths* testname curr-test-path)
;; NB// Was this for the test or for the parent in an iterated test?
;;(cdb:test-set-rundir! *runremote* run-id testname "" (filedb:register-path *fdb* lnkpath)) ;; toptest-path)
(rmt:general-call 'test-set-rundir run-id lnkpath testname "") ;; toptest-path)
(if (or (not curr-test-path)
(not (directory-exists? toptest-path)))
|
︙ | | |