Overview
| Comment: | Added friendly loading of runs for situation where there are 1000's of runs |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.55 |
| Files: | files | file ages | folders |
| SHA1: |
00424f30c1e421ad206b5ad1c6962d07 |
| User & Date: | mrwellan on 2013-07-19 22:56:56 |
| Other Links: | branch diff | manifest | tags |
Context
|
2013-07-26
| ||
| 10:41 | Merged dev to v1.55 check-in: bfa3ce6e1b user: mrwellan tags: v1.55, v1.5509 | |
|
2013-07-21
| ||
| 17:18 | Merged v1.55 branch into development check-in: e5526cab47 user: matt tags: dev | |
|
2013-07-19
| ||
| 22:56 | Added friendly loading of runs for situation where there are 1000's of runs check-in: 00424f30c1 user: mrwellan tags: v1.55 | |
| 10:30 | Updated help for refdb and fixed case where the sheet or row doesn't exist check-in: 3d0cd915c5 user: mrwellan tags: v1.55 | |
Changes
Modified dashboard.scm from [a4e53bb6b5] to [163e8cf671].
| ︙ | ︙ | |||
977 978 979 980 981 982 983 | ;; Update the runs tree (for-each (lambda (run-id) (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) *keys*)) (run-name (db:get-value-by-header run-record runs-header "runname")) (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) | | > > > | | | | | | | < < | | | | 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 | ;; Update the runs tree (for-each (lambda (run-id) (let* ((run-record (hash-table-ref/default runs-hash run-id #f)) (key-vals (map (lambda (key)(db:get-value-by-header run-record runs-header key)) *keys*)) (run-name (db:get-value-by-header run-record runs-header "runname")) (col-name (conc (string-intersperse key-vals "\n") "\n" run-name)) (run-path (append key-vals (list run-name))) (existing (tree:find-node tb run-path))) (if (not (hash-table-ref/default (dboard:data-get-path-run-ids *data*) run-path #f)) (begin (hash-table-set! (dboard:data-get-run-keys *data*) run-id run-path) ;; (iup:attribute-set! (dboard:data-get-runs-matrix *data*) ;; (conc rownum ":" colnum) col-name) ;; (hash-table-set! runid-to-col run-id (list colnum run-record)) ;; Here we update the tests treebox and tree keys (tree:add-node tb "Runs" run-path ;; (append key-vals (list run-name)) userdata: (conc "run-id: " run-id)) (hash-table-set! (dboard:data-get-path-run-ids *data*) run-path run-id) ;; (set! colnum (+ colnum 1)) )))) run-ids) (iup:attribute-set! run-matrix "CLEARVALUE" "CONTENTS") (iup:attribute-set! run-matrix "CLEARATTRIB" "CONTENTS") (iup:attribute-set! run-matrix "NUMCOL" max-col ) (iup:attribute-set! run-matrix "NUMLIN" (if (< max-row max-visible) max-visible max-row)) ;; min of 20 ;; (iup:attribute-set! run-matrix "NUMCOL_VISIBLE" max-col) ;; (iup:attribute-set! run-matrix "NUMLIN_VISIBLE" (if (> max-row max-visible) max-visible max-row)) |
| ︙ | ︙ |
Modified db.scm from [383d15bff3] to [aba54015ac].
| ︙ | ︙ | |||
707 708 709 710 711 712 713 | ;; 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 ;; | | | > > > | 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 |
;; 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 db 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 '())
(key-patt "")
(runwildtype (if (substring-index "%" runnamepatt) "like" "glob"))
(qry-str #f)
(keyvals (if targpatt (keys:target->keyval keys targpatt) '())))
(for-each (lambda (keyval)
(let* ((key (car keyval))
(patt (cadr keyval))
(fulkey (conc ":" key))
(wildtype (if (substring-index "%" patt) "like" "glob")))
(if patt
(set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'"))
(begin
(debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey)
(exit 6)))))
keyvals)
(set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time"
(if limit (conc " LIMIT " limit) "")
(if offset (conc " OFFSET " offset) "")
";"))
(debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt)
(sqlite3:for-each-row
(lambda (a . r)
(set! res (cons (list->vector (cons a r)) res)))
db
qry-str
runnamepatt)
|
| ︙ | ︙ |
Modified mt.scm from [db144d7ff3] to [0026287ae9].
| ︙ | ︙ | |||
37 38 39 40 41 42 43 | ;; 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 (mt:get-runs-by-patt keys runnamepatt targpatt) | | > > > > > > > > > > > > > > > > > > > | 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 |
;; 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 (mt:get-runs-by-patt keys runnamepatt targpatt)
(let loop ((runsdat (cdb:remote-run db:get-runs-by-patt #f keys runnamepatt targpatt 0 500))
(res '())
(offset 0)
(limit 500))
(print "runsdat: " runsdat)
(let* ((header (vector-ref runsdat 0))
(runslst (vector-ref runsdat 1))
(full-list (append res runslst))
(have-more (eq? (length runslst) limit)))
(debug:print 0 "header: " header " runslst: " runslst " have-more: " have-more)
(if have-more
(let ((new-offset (+ offset limit))
(next-batch (cdb:remote-run db:get-runs-by-patt #f keys runnamepatt targpatt offset limit)))
(debug:print-info 4 "More than " limit " runs, have " (length full-list) " runs so far.")
(debug:print-info 0 "next-batch: " next-batch)
(loop next-batch
full-list
new-offset
limit))
(vector header full-list)))))
;;======================================================================
;; T E S T S
;;======================================================================
(define (mt:get-tests-for-run run-id testpatt states status #!key (not-in #t) (sort-by #f) (qryvals #f))
(let loop ((testsdat (cdb:remote-run db:get-tests-for-run #f run-id testpatt states status 0 500 not-in sort-by qryvals: qryvals))
|
| ︙ | ︙ |