1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
|
(define (db:get-test-id dbstruct run-id testname item-path)
(let* ((db (db:get-db dbstruct run-id)))
(db:first-result-default
(db:get-db dbstruct run-id)
"SELECT id FROM tests WHERE testname=? AND item_path=?;"
#f ;; the default
testname item-path)))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir"))
;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
(if (null? fields)
#f
(let loop ((hed (car fields))
(tal (cdr fields))
(indx 0))
(if (equal? fieldname hed)
indx
(if (null? tal)
#f
(loop (car tal)(cdr tal)(+ indx 1)))))))
(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))
;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
(let ((db (db:get-db dbstruct run-id))
(res '()))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir)
res)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
|
>
>
>
>
>
>
>
>
>
>
>
|
|
>
|
|
|
|
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
|
(define (db:get-test-id dbstruct run-id testname item-path)
(let* ((db (db:get-db dbstruct run-id)))
(db:first-result-default
(db:get-db dbstruct run-id)
"SELECT id FROM tests WHERE testname=? AND item_path=?;"
#f ;; the default
testname item-path)))
;; overload the unused attemptnum field for the process id of the runscript or
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
(sqlite3:execute (db:get-db dbstruct run-id) "UPDATE tests SET attemptnum=? WHERE id=?;"
pid test-id))
(define (db:test-get-top-process-pid dbstruct run-id test-id)
(sqlite3:first-result (db:get-db dbstruct run-id) "SELECT attemptnum FROM tests WHERE id=?;"
run-id test-id))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum"))
;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
(if (null? fields)
#f
(let loop ((hed (car fields))
(tal (cdr fields))
(indx 0))
(if (equal? fieldname hed)
indx
(if (null? tal)
#f
(loop (car tal)(cdr tal)(+ indx 1)))))))
(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))
;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
(let ((db (db:get-db dbstruct run-id))
(res '()))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum)
res)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
|
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
|
(db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)))
run-ids)))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id))
(res #f))
(sqlite3:for-each-row
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|
|
|
|
|
|
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
|
(db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)))
run-ids)))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id))
(res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|