︙ | | | ︙ | |
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(if (not dbexists)
(db:initialize-main-db db))
(dbr:dbstruct-set-main! dbstruct db)
db))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup #!key (local #f))
(let ((dbstruct (make-dbr:dbstruct path: *toppath* local: local)))
(db:get-db dbstruct #f) ;; force one call to main
;; (if (not sdb:qry)
;; (begin
;; (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
;; (sdb:qry 'setup #f)
;; ;; Initialize with some known needed strings, NOTE: set this up to only execute on first db initialization
|
|
|
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
(if (not dbexists)
(db:initialize-main-db db))
(dbr:dbstruct-set-main! dbstruct db)
db))))
;; Make the dbstruct, setup up auxillary db's and call for main db at least once
;;
(define (db:setup run-id #!key (local #f))
(let ((dbstruct (make-dbr:dbstruct path: *toppath* local: local)))
(db:get-db dbstruct #f) ;; force one call to main
;; (if (not sdb:qry)
;; (begin
;; (set! sdb:qry (make-sdb:qry (conc *toppath* "/db/strings.db"))) ;; we open the normalization helpers here
;; (sdb:qry 'setup #f)
;; ;; Initialize with some known needed strings, NOTE: set this up to only execute on first db initialization
|
︙ | | | ︙ | |
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
|
(lambda (key)
(set! res (cons key res)))
(db:get-db dbstruct #f)
"SELECT fieldname FROM keys ORDER BY id DESC;")))
(set! *db-keys* res)
res)))
;;
(define (db:get-value-by-header row header field)
(debug:print-info 4 "db:get-value-by-header row: " row " header: " header " field: " field)
(if (null? header) #f
(let loop ((hed (car header))
(tal (cdr header))
(n 0))
(if (equal? hed field)
(vector-ref row n)
(if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
;;======================================================================
;; R U N S
;;======================================================================
(define (db:get-run-name-from-id dbstruct run-id)
(let ((res #f))
(sqlite3:for-each-row
|
|
<
>
>
>
>
>
|
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
|
(lambda (key)
(set! res (cons key res)))
(db:get-db dbstruct #f)
"SELECT fieldname FROM keys ORDER BY id DESC;")))
(set! *db-keys* res)
res)))
;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
(if (null? header) #f
(let loop ((hed (car header))
(tal (cdr header))
(n 0))
(if (equal? hed field)
(vector-ref row n)
(if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
;; Accessors for the header/data structure
;; get rows and header from
(define (db:get-header vec)(vector-ref vec 0))
(define (db:get-rows vec)(vector-ref vec 1))
;;======================================================================
;; R U N S
;;======================================================================
(define (db:get-run-name-from-id dbstruct run-id)
(let ((res #f))
(sqlite3:for-each-row
|
︙ | | | ︙ | |
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
|
runs-info)
res))
;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db-get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
;; to extract info from the structure returned
;;
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
(let* ((tmp (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
(keystr (car tmp))
(header (cadr tmp))
(res '())
|
|
|
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
|
runs-info)
res))
;; db:get-runs-by-patt
;; get runs by list of criteria
;; register a test run with the db
;;
;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
;; to extract info from the structure returned
;;
(define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name)
(let* ((tmp (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))
(keystr (car tmp))
(header (cadr tmp))
(res '())
|
︙ | | | ︙ | |
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
|
(lambda (a . r)
(set! res (cons (list->vector (cons a r)) res)))
(db:get-db dbstruct #f)
qry-str
runnamepatt)))
(vector header res)))
;; use (get-value-by-header (db:get-header runinfo)(db:get-row runinfo))
(define (db:get-run-info dbstruct run-id)
;;(if (hash-table-ref/default *run-info-cache* run-id #f)
;; (hash-table-ref *run-info-cache* run-id)
(let* ((res (vector #f #f #f #f))
(keys (db:get-keys dbstruct))
(remfields (list "id" "runname" "state" "status" "owner" "event_time"))
(header (append keys remfields))
|
|
|
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
|
(lambda (a . r)
(set! res (cons (list->vector (cons a r)) res)))
(db:get-db dbstruct #f)
qry-str
runnamepatt)))
(vector header res)))
;; use (get-value-by-header (db:get-header runinfo)(db:get-rows runinfo))
(define (db:get-run-info dbstruct run-id)
;;(if (hash-table-ref/default *run-info-cache* run-id #f)
;; (hash-table-ref *run-info-cache* run-id)
(let* ((res (vector #f #f #f #f))
(keys (db:get-keys dbstruct))
(remfields (list "id" "runname" "state" "status" "owner" "event_time"))
(header (append keys remfields))
|
︙ | | | ︙ | |