103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
db))
(define (db:sync-to fromdb todb)
;; strategy
;; 1. Get all run-ids
;; 2. For each run-id
;; a. Sync that run in a transaction
(let* ((run-ids (db:get-all-run-ids fromdb))
(tgetstmt (sqlite3:prepare todb "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"))
(tputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO tests (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );"))
(trecchgd 0))
;; First sync tests data
(for-each
(lambda (run-id)
(let ((tdats (db:get-all-tests-info-by-run-id fromdb run-id)))
;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
(for-each
(lambda (tdat) ;; iterate over tests
(let ((test-id (vector-ref tdat 0)))
(sqlite3:with-transaction
todb
(lambda ()
(let ((curr-tdat #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! curr-tdat (apply vector a b)))
tgetstmt
test-id)
(if (not (equal? curr-tdat tdat)) ;; something changed
(begin
(debug:print 0 " test-id: " test-id
"\ncurr-tdat: " curr-tdat
"\n tdat: " tdat)
(apply sqlite3:execute tputstmt (vector->list tdat))
(set! trecchgd (+ trecchgd 1)))))))))
tdats)))
run-ids)
(sqlite3:finalize! tgetstmt)
(sqlite3:finalize! tputstmt)
(if (> trecchgd 0)(debug:print 0 "sync'd " trecchgd " changed records in tests table"))
;; Next sync runs table
(let* ((rrecchgd 0)
(rdats '())
(keys (db:get-keys fromdb))
(rstdfields (conc "id," (string-intersperse keys ",") ",runname,state,status,owner,event_time,comment,fail_count,pass_count"))
(rnumfields (length (string-split rstdfields ",")))
(runslots (string-intersperse (make-list rnumfields "?") ","))
(rgetstmt (sqlite3:prepare todb (conc "SELECT " rstdfields " FROM runs WHERE id=?;")))
(rputstmt (sqlite3:prepare todb (conc "INSERT OR REPLACE INTO runs (" rstdfields ") VALUES ( " runslots " );"))))
;; first collect all the source run data
|
>
>
>
|
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
|
|
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
db))
(define (db:sync-to fromdb todb)
;; strategy
;; 1. Get all run-ids
;; 2. For each run-id
;; a. Sync that run in a transaction
(let ((trecchgd 0)
(rrecchgd 0)
(tmrecchgd 0))
;; First sync test_meta data
(let ((tmgetstmt (sqlite3:prepare todb "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta WHERE id=?;"))
(tmputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO test_meta (id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?);"))
(tmdats (db:testmeta-get-all fromdb)))
;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
(for-each
(lambda (tmdat) ;; iterate over tests
(let ((testm-id (vector-ref tmdat 0)))
(sqlite3:with-transaction
todb
(lambda ()
(let ((curr-tmdat #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! curr-tmdat (apply vector a b)))
tmgetstmt testm-id)
(if (not (equal? curr-tmdat tmdat)) ;; something changed
(begin
(debug:print 0 " test-id: " test-id
"\ncurr-tdat: " curr-tmdat
"\n tdat: " tmdat)
(apply sqlite3:execute tputstmt (vector->list tmdat))
(set! tmrecchgd (+ tmrecchgd 1)))))))))
tmdats)
(sqlite3:finalize! tmgetstmt)
(sqlite3:finalize! tmputstmt))
;; First sync tests data
(let ((run-ids (db:get-all-run-ids fromdb))
(tgetstmt (sqlite3:prepare todb "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;"))
(tputstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO tests (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment)
VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );")))
(for-each
(lambda (run-id)
(let ((tdats (db:get-all-tests-info-by-run-id fromdb run-id)))
;; (debug:print 7 "Updating as many as " (length tdats) " records for run " run-id)
(for-each
(lambda (tdat) ;; iterate over tests
(let ((test-id (vector-ref tdat 0)))
(sqlite3:with-transaction
todb
(lambda ()
(let ((curr-tdat #f))
(sqlite3:for-each-row
(lambda (a . b)
(set! curr-tdat (apply vector a b)))
tgetstmt
test-id)
(if (not (equal? curr-tdat tdat)) ;; something changed
(begin
(debug:print 0 " test-id: " test-id
"\ncurr-tdat: " curr-tdat
"\n tdat: " tdat)
(apply sqlite3:execute tputstmt (vector->list tdat))
(set! trecchgd (+ trecchgd 1)))))))))
tdats)))
run-ids)
(sqlite3:finalize! tgetstmt)
(sqlite3:finalize! tputstmt))
;; Next sync runs table
(let* ((rdats '())
(keys (db:get-keys fromdb))
(rstdfields (conc "id," (string-intersperse keys ",") ",runname,state,status,owner,event_time,comment,fail_count,pass_count"))
(rnumfields (length (string-split rstdfields ",")))
(runslots (string-intersperse (make-list rnumfields "?") ","))
(rgetstmt (sqlite3:prepare todb (conc "SELECT " rstdfields " FROM runs WHERE id=?;")))
(rputstmt (sqlite3:prepare todb (conc "INSERT OR REPLACE INTO runs (" rstdfields ") VALUES ( " runslots " );"))))
;; first collect all the source run data
|
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
|
CONSTRAINT metadat_constraint UNIQUE (var));")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY,
testname TEXT DEFAULT '',
author TEXT DEFAULT '',
owner TEXT DEFAULT '',
description TEXT DEFAULT '',
reviewed TIMESTAMP,
iterated TEXT DEFAULT '',
avg_runtime REAL,
avg_disk REAL,
tags TEXT DEFAULT '',
jobgroup TEXT DEFAULT 'default',
CONSTRAINT test_meta_constraint UNIQUE (testname));")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
test_id INTEGER,
category TEXT DEFAULT '',
variable TEXT,
|
|
|
|
|
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
|
CONSTRAINT metadat_constraint UNIQUE (var));")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS access_log (id INTEGER PRIMARY KEY, user TEXT, accessed TIMESTAMP, args TEXT);")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_meta (id INTEGER PRIMARY KEY,
testname TEXT DEFAULT '',
author TEXT DEFAULT '',
owner TEXT DEFAULT '',
description TEXT DEFAULT '',
reviewed TIMESTAMP DEFAULT (strftime('%s','now')),
iterated TEXT DEFAULT '',
avg_runtime REAL DEFAULT -1,
avg_disk REAL DEFAULT -1,
tags TEXT DEFAULT '',
jobgroup TEXT DEFAULT 'default',
CONSTRAINT test_meta_constraint UNIQUE (testname));")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_data (id INTEGER PRIMARY KEY,
test_id INTEGER,
category TEXT DEFAULT '',
variable TEXT,
|
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
|
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res)))
(define (db:get-test-info db run-id testname item-path)
(db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
(define (db:test-set-comment db test-id comment)
(sqlite3:execute
db
"UPDATE tests SET comment=? WHERE id=?;"
comment test-id))
(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir)
(cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path))
(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
(cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))
(define (db:test-get-rundir-from-test-id db test-id)
|
<
<
<
<
<
<
|
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
|
(conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id in ("
(string-intersperse (map conc test-ids) ",") ");"))
res)))
(define (db:get-test-info db run-id testname item-path)
(db:get-test-info-by-id db (db:get-test-id db run-id testname item-path)))
(define (cdb:test-set-rundir! serverdat run-id test-name item-path rundir)
(cdb:client-call serverdat 'test-set-rundir #t *default-numtries* rundir run-id test-name item-path))
(define (cdb:test-set-rundir-by-test-id serverdat test-id rundir)
(cdb:client-call serverdat 'test-set-rundir-by-test-id #t *default-numtries* rundir test-id))
(define (db:test-get-rundir-from-test-id db test-id)
|
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
|
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
stmtname)
db:queries)))
(if q (car q) #f))))
(apply sqlite3:execute db query params)
#t))
(define (db:process-queue-item db item)
(let* ((stmt-key (cdb:packet-get-qtype item))
(qry-sig (cdb:packet-get-query-sig item))
(return-address (cdb:packet-get-client-sig item))
(params (cdb:packet-get-params item))
(query (let ((q (alist-ref stmt-key db:queries)))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
|
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
stmtname)
db:queries)))
(if q (car q) #f))))
(apply sqlite3:execute db query params)
#t))
;; get the previous record for when this test was run where all keys match but runname
;; returns #f if no such test found, returns a single test record if found
;;
;; Run this server-side
;;
(define (db:get-previous-test-run-record db run-id test-name item-path)
(let* ((keys (db:get-keys db))
(selstr (string-intersperse keys ","))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND "))
(keyvals #f))
;; first look up the key values from the run selected by run-id
(sqlite3:for-each-row
(lambda (a . b)
(set! keyvals (cons a b)))
db
(conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
(if (not keyvals)
#f
(let ((prev-run-ids '()))
(apply sqlite3:for-each-row
(lambda (id)
(set! prev-run-ids (cons id prev-run-ids)))
db
(conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
;; for each run starting with the most recent look to see if there is a matching test
;; if found then return that matching test record
(debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals ", previous run ids found: " prev-run-ids)
(if (null? prev-run-ids) #f
(let loop ((hed (car prev-run-ids))
(tal (cdr prev-run-ids)))
(let ((results (db:get-tests-for-run db hed (conc test-name "/" item-path)'() '() #f #f #f #f #f)))
(debug:print 4 "Got tests for run-id " run-id ", test-name " test-name ", item-path " item-path ": " results)
(if (and (null? results)
(not (null? tal)))
(loop (car tal)(cdr tal))
(if (null? results) #f
(car results))))))))))
;; get the previous records for when these tests were run where all keys match but runname
;; NB// Merge this with test:get-previous-test-run-records? This one looks for all matching tests
;; can use wildcards. Also can likely be factored in with get test paths?
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records db run-id test-name item-path)
(let* ((keys (db:get-keys db))
(selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
(qrystr (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
(keyvals #f)
(tests-hash (make-hash-table)))
;; first look up the key values from the run selected by run-id
(sqlite3:for-each-row
(lambda (a . b)
(set! keyvals (cons a b)))
db
(conc "SELECT " selstr " FROM runs WHERE id=? ORDER BY event_time DESC;") run-id)
(if (not keyvals)
'()
(let ((prev-run-ids '()))
(apply sqlite3:for-each-row
(lambda (id)
(set! prev-run-ids (cons id prev-run-ids)))
db
(conc "SELECT id FROM runs WHERE " qrystr " AND id != ?;") (append keyvals (list run-id)))
;; collect all matching tests for the runs then
;; extract the most recent test and return that.
(debug:print 4 "selstr: " selstr ", qrystr: " qrystr ", keyvals: " keyvals
", previous run ids found: " prev-run-ids)
(if (null? prev-run-ids) '() ;; no previous runs? return null
(let loop ((hed (car prev-run-ids))
(tal (cdr prev-run-ids)))
(let ((results (db:get-tests-for-run db hed (conc test-name "/" item-path) '() '() #f #f #f #f #f)))
(debug:print 4 "Got tests for run-id " run-id ", test-name " test-name
", item-path " item-path " results: " (intersperse results "\n"))
;; Keep only the youngest of any test/item combination
(for-each
(lambda (testdat)
(let* ((full-testname (conc (db:test-get-testname testdat) "/" (db:test-get-item-path testdat)))
(stored-test (hash-table-ref/default tests-hash full-testname #f)))
(if (or (not stored-test)
(and stored-test
(> (db:test-get-event_time testdat)(db:test-get-event_time stored-test))))
;; this test is younger, store it in the hash
(hash-table-set! tests-hash full-testname testdat))))
results)
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
(define (db:process-queue-item db item)
(let* ((stmt-key (cdb:packet-get-qtype item))
(qry-sig (cdb:packet-get-query-sig item))
(return-address (cdb:packet-get-client-sig item))
(params (cdb:packet-get-params item))
(query (let ((q (alist-ref stmt-key db:queries)))
|
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
|
;; create a new record for a given testname
(define (db:testmeta-add-record db testname)
(sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))
;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
(sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (db:csv->test-data db test-id csvdata #!key (work-area #f))
(debug:print 4 "test-id " test-id ", csvdata: " csvdata)
|
>
>
>
>
>
>
>
>
>
|
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
|
;; create a new record for a given testname
(define (db:testmeta-add-record db testname)
(sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags) VALUES (?,'','','','','','','','');" testname))
;; update one of the testmeta fields
(define (db:testmeta-update-field db testname field value)
(sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;") value testname))
(define (db:testmeta-get-all db)
(let ((res '()))
(sqlite3:for-each-row
(lambda (a . b)
(set! res (cons (apply vector a b) res)))
db
"SELECT id,testname,author,owner,description,reviewed,iterated,avg_runtime,avg_disk,tags,jobgroup FROM test_meta;")
res))
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (db:csv->test-data db test-id csvdata #!key (work-area #f))
(debug:print 4 "test-id " test-id ", csvdata: " csvdata)
|