2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
|
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
|
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
|
qry
run-id
)))
;; (case qryvals
;; ((shortlist)(map db:test-short-record->norm res))
;; ((#f) res)
;; (else res)))))
(if (eq? qryvals shortlist)
(if (eq? qryvals 'shortlist)
(for-each (lambda (inrec) (db:test-short-record->norm inrec)) res))
res)))
(define (db:test-short-record->norm inrec)
;; "id,run_id,testname,item_path,state,status"
;; "id,run_id,testname,state,status, event_time,host,cpuload,diskfree,uname,rundir, item_path, run_duration,final_logf,comment
(db-test-event_time-set! inrec -1)
(db-test-host-set! inrec "")
(db-test-cpuload-set! inrec -1)
(db-test-diskfree-set! inrec -1)
(db-test-uname-set! inrec "")
(db-test-rundir-set! inrec "-")
(db-test-run_duration-set! inrec "-")
(db-test-final_logf-set! inrec "-")
(db-test-comment-set! inrec "-")
(db:test-event_time-set! inrec -1)
(db:test-host-set! inrec "")
(db:test-cpuload-set! inrec -1)
(db:test-diskfree-set! inrec -1)
(db:test-uname-set! inrec "")
(db:test-rundir-set! inrec "-")
(db:test-run_duration-set! inrec "-")
(db:test-final_logf-set! inrec "-")
(db:test-comment-set! inrec "-")
;; (vector (vector-ref inrec 0) ;; id
;; (vector-ref inrec 1) ;; run_id
;; (vector-ref inrec 2) ;; testname
;; (vector-ref inrec 4) ;; state
;; (vector-ref inrec 5) ;; status
;; -1 "" -1 -1 "" "-"
;; (vector-ref inrec 3) ;; item-path
;; -1 "-" "-")
)
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
(let* ((res '())
(tests-match-qry (tests:match->sqlqry testpatt))
(qryfields '(id testname item_path state,status))
(qryfields '(id testname item_path state status))
(qryfields-str (string-join (map ->string qryfields) "," ))
(qry (conc "SELECT " qryfields-str " FROM tests WHERE run_id=? "
(if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))))
(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 (id testname item-path state status)
;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
(let ((1res make-db:test))
(let ((1res (make-db:test)))
(db:test-id-set! 1res id)
(db:test-testname-set! 1res testname)
(db:test-item_path-set! 1res item-path)
(db:test-item-path-set! 1res item-path)
(db:test-state-set! 1res state)
(db:test-status-set! 1res status)
(db:test-short-record->norm 1res)
(set! res (cons 1res res))))
;;(set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res)))
db
qry
|
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
|
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
|
-
+
-
+
|
(map (lambda (key val)
(conc key " like '" val "'"))
keynames
(string-split target "/"))
" AND "))
;; (testqry (tests:match->sqlqry testpatt))
(runsqry (sqlite3:prepare db (conc "SELECT id FROM runs WHERE " keystr " AND runname LIKE '" runname "';"))))
;; (debug:print 8 "db:test-paths-matching-keynames-target-new\n runsqry=" runsqry "\n tstsqry=" testqry)
;; (debug:print 8 "db:test-get-paths-matching-keynames-target-new\n runsqry=" runsqry "\n tstsqry=" testqry)
(sqlite3:for-each-row
(lambda (rid)
(set! row-ids (cons rid row-ids)))
runsqry)
(sqlite3:finalize! runsqry)
row-ids))
(define (db:test-paths-matching-keynames-target-new dbstruct run-id keynames target res testpatt statepatt statuspatt runname)
(define (db:test-get-paths-matching-keynames-target-new dbstruct run-id keynames target res testpatt statepatt statuspatt runname)
(let* ((testqry (tests:match->sqlqry testpatt))
(tstsqry (conc "SELECT rundir FROM tests WHERE " testqry " AND state LIKE '" statepatt "' AND status LIKE '" statuspatt "' ORDER BY event_time ASC;")))
(db:with-db
dbstruct
run-id
#f
(lambda (db)
|