647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys keyvallst runname user) ;; was target, now keyvallst
(debug:print 4 "runs:rollup-run, keys: " keys " keyvallst: " keyvallst " :runname " runname " user: " user)
(let* (; (keyvalllst (keys:target->keyval keys target))
(new-run-id (runs:register-run db keys keyvallst runname "new" "n/a" user))
(prev-tests (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
(curr-tests (db-get-tests-for-run db new-run-id "%" "%" '() '()))
(curr-tests-hash (make-hash-table)))
(db:update-run-event_time db new-run-id)
;; index the already saved tests by testname and itemdat in curr-tests-hash
(for-each
(lambda (testdat)
(let* ((testname (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
|
|
|
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
;; This could probably be refactored into one complex query ...
(define (runs:rollup-run db keys keyvallst runname user) ;; was target, now keyvallst
(debug:print 4 "runs:rollup-run, keys: " keys " keyvallst: " keyvallst " :runname " runname " user: " user)
(let* (; (keyvalllst (keys:target->keyval keys target))
(new-run-id (runs:register-run db keys keyvallst runname "new" "n/a" user))
(prev-tests (test:get-matching-previous-test-run-records db new-run-id "%" "%"))
(curr-tests (rdb:get-tests-for-run db new-run-id "%" "%" '() '()))
(curr-tests-hash (make-hash-table)))
(db:update-run-event_time db new-run-id)
;; index the already saved tests by testname and itemdat in curr-tests-hash
(for-each
(lambda (testdat)
(let* ((testname (db:test-get-testname testdat))
(item-path (db:test-get-item-path testdat))
|
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
|
(new-test-record #f))
;; replace these with insert ... select
(apply sqlite3:execute
db
(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) "
"VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
new-run-id (cddr (vector->list testdat)))
(set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path '() '())))
(hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
;; Now duplicate the test steps
(debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
(sqlite3:execute
db
(conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
|
|
|
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
|
(new-test-record #f))
;; replace these with insert ... select
(apply sqlite3:execute
db
(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) "
"VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
new-run-id (cddr (vector->list testdat)))
(set! new-testdat (car (rdb:get-tests-for-run db new-run-id testname item-path '() '())))
(hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
;; Now duplicate the test steps
(debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
(sqlite3:execute
db
(conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
|