646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
|
(define (db:updater db)
(let loop ((start-time (current-time)))
(thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
(db:write-cached-data db)
(loop start-time)))
(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)
(if (not item-path)
(begin (debug:print 0 "WARNING: ITEMPATH not set.")
(set! item-path "")))
(mutex-lock! *incoming-mutex*)
(set! *incoming-data* (cons (vector 'meta-info
(current-seconds)
(list cpuload
diskfree
minutes
run-id
test-name
item-path)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
(if (not *cache-on*)(db:write-cached-data db)))
(define (db:write-cached-data db)
(let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE run_id=? AND testname=? AND item_path=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
(if (> (length data) 0)
(debug:print 4 "Writing cached data " data))
(mutex-lock! *incoming-mutex*)
(sqlite3:with-transaction
db
|
|
<
<
<
<
<
|
>
>
|
|
|
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
|
(define (db:updater db)
(let loop ((start-time (current-time)))
(thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
(db:write-cached-data db)
(loop start-time)))
(define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
(mutex-lock! *incoming-mutex*)
(set! *incoming-data* (cons (vector 'meta-info
(current-seconds)
(list cpuload
diskfree
minutes
test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree)
*incoming-data*))
(mutex-unlock! *incoming-mutex*)
(if *cache-on*
(debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info")
(db:write-cached-data db)))
(define (db:write-cached-data db)
(let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
(if (> (length data) 0)
(debug:print 4 "Writing cached data " data))
(mutex-lock! *incoming-mutex*)
(sqlite3:with-transaction
db
|
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
|
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:teststep-set-status! host port)
test-id teststep-name state-in status-in item-path comment logfile))
(db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile))))
(define (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
(let ((item-path (item-list->path itemdat)))
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-update-meta-info host port)
run-id test-name item-path minutes cpuload diskfree tmpfree))
(db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree))))
(define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port)
run-id test-name item-path status state))
|
|
<
|
|
|
|
|
|
|
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
|
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:teststep-set-status! host port)
test-id teststep-name state-in status-in item-path comment logfile))
(db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile))))
(define (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-update-meta-info host port)
test-id minutes cpuload diskfree tmpfree))
(db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)))
(define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
(if *runremote*
(let ((host (vector-ref *runremote* 0))
(port (vector-ref *runremote* 1)))
((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port)
run-id test-name item-path status state))
|