Overview
| Comment: | Converted anther call from imperative to functional and added more statement caching |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
9277e72e1446ee047b97e4dc6b1732b2 |
| User & Date: | matt on 2020-08-15 23:19:48 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-08-16
| ||
| 22:07 | Added glob caching for apparently expensive regexp execution check-in: b4a13d1106 user: matt tags: v1.65 | |
|
2020-08-15
| ||
| 23:19 | Converted anther call from imperative to functional and added more statement caching check-in: 9277e72e14 user: matt tags: v1.65 | |
| 18:22 | Converted a call from imperative to functional and added statement caching. check-in: 2bc12a6a8b user: matt tags: v1.65 | |
Changes
Modified db.scm from [77ff50b321] to [5d700139ad].
| ︙ | ︙ | |||
92 93 94 95 96 97 98 99 100 101 102 103 104 105 |
(hash-table-set! dat key1 (make-hash-table))
(db:hoh-set! dat key1 key2 val)))))
(define (db:hoh-get dat key1 key2)
(let* ((subhash (hash-table-ref/default dat key1 #f)))
(and subhash
(hash-table-ref/default subhash key2 #f))))
;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
(define (db:general-sqlite-error-dump exn stmt . params)
(let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
| > > > > > > > > | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 |
(hash-table-set! dat key1 (make-hash-table))
(db:hoh-set! dat key1 key2 val)))))
(define (db:hoh-get dat key1 key2)
(let* ((subhash (hash-table-ref/default dat key1 #f)))
(and subhash
(hash-table-ref/default subhash key2 #f))))
(define (db:get-cache-stmth dbstruct db stmt)
(let* ((stmt-cache (dbr:dbstruct-stmt-cache dbstruct))
(stmth (db:hoh-get stmt-cache db stmt)))
(or stmth
(let* ((newstmth (sqlite3:prepare db stmt)))
(db:hoh-set! stmt-cache db stmt newstmth)
newstmth))))
;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
(define (db:general-sqlite-error-dump exn stmt . params)
(let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) ;; RADT ... how does this work?
|
| ︙ | ︙ | |||
2885 2886 2887 2888 2889 2890 2891 2892 |
(conc " ORDER BY " sort-by " ")
" ")))
(if sort-order sort-order " ")
(if limit (conc " LIMIT " limit) " ")
(if offset (conc " OFFSET " offset) " ")
";"
)))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
| > | | > > | > | | < < > > > | | | | | | | 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 |
(conc " ORDER BY " sort-by " ")
" ")))
(if sort-order sort-order " ")
(if limit (conc " LIMIT " limit) " ")
(if offset (conc " OFFSET " offset) " ")
";"
)))
(debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
(let* ((res (db:with-db dbstruct run-id #f
(lambda (db)
(let* ((stmth (db:get-cache-stmth dbstruct db qry)))
(reverse
(sqlite3:fold-row
(lambda (res . row)
;; id run-id testname state status event-time host cpuload
;; diskfree uname rundir item-path run-duration final-logf comment)
(cons (list->vector row) res))
'()
stmth
(or run-id 1) ;; 1 > 0 , for the case where we are seeking tests matching criteral for all runs
)))))))
(case qryvals
((shortlist)(map db:test-short-record->norm res))
((#f) res)
(else 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
(vector (vector-ref inrec 0) ;; id
(vector-ref inrec 1) ;; run_id
(vector-ref inrec 2) ;; testname
|
| ︙ | ︙ |