Overview
Comment: | updated more calls to dbi, fixed fold-row issues |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63-gasket |
Files: | files | file ages | folders |
SHA1: |
0a0d3102fc0dddba2851ae5421ac93a9 |
User & Date: | srehman on 2016-12-19 15:24:59 |
Other Links: | branch diff | manifest | tags |
Context
2016-12-20
| ||
13:48 | dashboard launches, fixing issues with megatest calls check-in: 66f80f8403 user: srehman tags: v1.63-gasket | |
2016-12-19
| ||
15:24 | updated more calls to dbi, fixed fold-row issues check-in: 0a0d3102fc user: srehman tags: v1.63-gasket | |
12:04 | changed more sqlite3 calls with dbi check-in: e153260fa6 user: srehman tags: v1.63-gasket | |
Changes
Modified datashare.scm from [cf9c777e1a] to [ff237ff27e].
︙ | ︙ | |||
142 143 144 145 146 147 148 | destlink TEXT);" "CREATE TABLE disks (id INTEGER PRIMARY KEY, storegrp TEXT, path TEXT);"))) (define (datashare:register-data db area version-name store-type submitter quality source-path comment) | | | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | destlink TEXT);" "CREATE TABLE disks (id INTEGER PRIMARY KEY, storegrp TEXT, path TEXT);"))) (define (datashare:register-data db area version-name store-type submitter quality source-path comment) (let ((iter-qry (dbi:prepare db "SELECT max(iteration) FROM pkgs WHERE area=? AND version_name=?;")) (next-iteration 0)) (dbi:with-transaction db (lambda () (dbi:for-each-row (lambda (iteration) (if (and (number? iteration) |
︙ | ︙ |
Modified db.scm from [0bae73b2af] to [2b681408f6].
︙ | ︙ | |||
269 270 271 272 273 274 275 | ;; ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's? ;; (db:sync-tables db:sync-tests-only *megatest-db* db) ;; db)) ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; (define (db:open-db dbstruct #!key (areapath #f)) | < | 269 270 271 272 273 274 275 276 277 278 279 280 281 282 | ;; ;;; (mutex-unlock! *rundb-mutex*) ;;; why did we need a mutex on opening db's? ;; (db:sync-tables db:sync-tests-only *megatest-db* db) ;; db)) ;; This routine creates the db if not already present. It is only called if the db is not already opened ;; (define (db:open-db dbstruct #!key (areapath #f)) (let ((tmpdb (dbr:dbstruct-tmpdb dbstruct))) ;; RA => Returns the first reference in dbstruct (if tmpdb tmpdb ;; (mutex-lock! *rundb-mutex*) (let* ((dbpath (db:dbfile-path)) ;; 0)) (dbexists (file-exists? dbpath)) (dbfexists (file-exists? (conc dbpath "/megatest.db"))) |
︙ | ︙ | |||
1674 1675 1676 1677 1678 1679 1680 | ;; M E T A G E T A N D S E T V A R S ;;====================================================================== ;; returns number if string->number is successful, string otherwise ;; also updates *global-delta* ;; (define (db:get-var dbstruct var) | < | 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 | ;; M E T A G E T A N D S E T V A R S ;;====================================================================== ;; returns number if string->number is successful, string otherwise ;; also updates *global-delta* ;; (define (db:get-var dbstruct var) (let* ((res #f) (dbdat (db:get-db dbstruct #f)) (db (db:dbdat-get-db dbdat))) (dbi:for-each-row (lambda (val) (set! res (vector-ref val 0))) db |
︙ | ︙ | |||
1720 1721 1722 1723 1724 1725 1726 | ;; re-read the db over and over again for the keys since they never ;; change ;; why get the keys from the db? why not get from the *configdat* ;; using keys:config-get-fields? (define (db:get-keys dbstruct) | < | 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 | ;; re-read the db over and over again for the keys since they never ;; change ;; why get the keys from the db? why not get from the *configdat* ;; using keys:config-get-fields? (define (db:get-keys dbstruct) (if *db-keys* *db-keys* (let ((res '())) (db:with-db dbstruct #f #f (lambda (db) (dbi:for-each-row (lambda (key) (set! res (cons (vector-ref key 0) res))) |
︙ | ︙ | |||
1762 1763 1764 1765 1766 1767 1768 | dbstruct #f ;; this is for the main runs db #f ;; does not modify db (lambda (db) (let ((res #f)) (dbi:for-each-row (lambda (runname) | < < | 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 | dbstruct #f ;; this is for the main runs db #f ;; does not modify db (lambda (db) (let ((res #f)) (dbi:for-each-row (lambda (runname) (set! res runname)) db "SELECT runname FROM runs WHERE id=?;" run-id) res)))) (define (db:get-run-key-val dbstruct run-id key) (db:with-db dbstruct #f #f (lambda (db) (let ((res #f)) (dbi:for-each-row (lambda (val) (set! res val)) db (conc "SELECT " key " FROM runs WHERE id=?;") run-id) res)))) ;; keys list to key1,key2,key3 ... |
︙ | ︙ | |||
3249 3250 3251 3252 3253 3254 3255 | ;; ;; ((RUNNING) (db:general-call dbdat 'top-test-set-running (list test-name))) ;; ;; ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))) ;; ;; ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name)))) ;; ;; #f) ;; ;; ))) (define (db:get-all-state-status-counts-for-test db run-id test-name item-path) | | | | | 3244 3245 3246 3247 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 | ;; ;; ((RUNNING) (db:general-call dbdat 'top-test-set-running (list test-name))) ;; ;; ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))) ;; ;; ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name)))) ;; ;; #f) ;; ;; ))) (define (db:get-all-state-status-counts-for-test db run-id test-name item-path) (dbi:map-row (lambda (state status count) (make-dbr:counts state: state status: status count: count)) db "SELECT state,status,count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' AND item_path !=? GROUP BY state,status;" run-id test-name item-path)) (define (db:get-all-item-states db run-id test-name) (dbi:map-row (lambda (a) a) db "SELECT DISTINCT state FROM tests WHERE item_path != '' AND state != 'DELETED' AND run_id=? AND testname=?" run-id test-name)) (define (db:get-all-item-statuses db run-id test-name) (dbi:map-row (lambda (a) a) db "SELECT DISTINCT status FROM tests WHERE item_path != '' AND state != 'DELETED' AND state='COMPLETED' AND run_id=? AND testname=?" run-id test-name)) (define (db:test-get-logfile-info dbstruct run-id test-name) (db:with-db |
︙ | ︙ |
Modified megatest.scm from [52edf8a8de] to [5ec6878ec1].
︙ | ︙ | |||
1705 1706 1707 1708 1709 1710 1711 | (if (args:get-arg "-summarize-items") ;; DO NOT run remote (tests:summarize-items run-id test-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") (if (null? remargs) (begin (debug:print-error 0 *default-log-port* "nothing specified to run!") | | | 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1716 1717 1718 1719 | (if (args:get-arg "-summarize-items") ;; DO NOT run remote (tests:summarize-items run-id test-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") (if (null? remargs) (begin (debug:print-error 0 *default-log-port* "nothing specified to run!") (if db (dbi:close db)) (exit 6)) (let* ((stepname (args:get-arg "-runstep")) (logprofile (args:get-arg "-logpro")) (logfile (conc stepname ".log")) (cmd (if (null? remargs) #f (car remargs))) (params (if cmd (cdr remargs) '())) (exitstat #f) |
︙ | ︙ | |||
1766 1767 1768 1769 1770 1771 1772 | (list ":value" ":tol" ":expected" ":first_err" ":first_warn" ":units" ":category" ":variable")) res))) (if (and (args:get-arg "-test-status") (or (not state) (not status))) (begin (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -test-status\n" help) | | | | | 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 | (list ":value" ":tol" ":expected" ":first_err" ":first_warn" ":units" ":category" ":variable")) res))) (if (and (args:get-arg "-test-status") (or (not state) (not status))) (begin (debug:print-error 0 *default-log-port* "You must specify :state and :status with every call to -test-status\n" help) (if (dbi:database? db)(dbi:close db)) (exit 6))) (let* ((msg (args:get-arg "-m")) (numoth (length (hash-table-keys otherdata)))) ;; Convert to rpc inside the tests:test-set-status! call, not here (tests:test-set-status! run-id test-id state newstatus msg otherdata work-area: work-area)))) (if (dbi:database? db)(dbi:close db)) (set! *didsomething* #t)))) ;;====================================================================== ;; Various helper commands can go below here ;;====================================================================== (if (or (args:get-arg "-showkeys") (args:get-arg "-show-keys")) (let ((db #f) (keys #f)) (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to setup, exiting") (exit 1))) (set! keys (rmt:get-keys)) ;; db)) (debug:print 1 *default-log-port* "Keys: " (string-intersperse keys ", ")) (if (dbi:database? db)(dbi:close db)) (set! *didsomething* #t))) (if (args:get-arg "-gui") (begin (debug:print 0 *default-log-port* "Look at the dashboard for now") ;; (megatest-gui) (set! *didsomething* #t))) |
︙ | ︙ |
Modified tasks.scm from [772f631b34] to [c3a67b14aa].
︙ | ︙ | |||
101 102 103 104 105 106 107 | (write-access (file-write-access? dbpath)) (dbdat '()) (mdb (cond ;; what the hek is *toppath* doing here? ((and (string? *toppath*)(file-write-access? *toppath*)) (set! dbdat (cons (cons 'dbname dbfile) dbdat)) (dbi:open 'sqlite3 dbdat)) ((file-read-access? dbpath) (dbi:open 'sqlite3 dbdat)) | | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 | (write-access (file-write-access? dbpath)) (dbdat '()) (mdb (cond ;; what the hek is *toppath* doing here? ((and (string? *toppath*)(file-write-access? *toppath*)) (set! dbdat (cons (cons 'dbname dbfile) dbdat)) (dbi:open 'sqlite3 dbdat)) ((file-read-access? dbpath) (dbi:open 'sqlite3 dbdat)) (else (dbi:open 'sqlite3 '((dbname . ":memory:"))))))) ;; (never-give-up-open-db dbpath)) ;;(handler (make-busy-timeout 36000))) (if (and exists (not write-access)) (set! *db-write-access* write-access)) ;; only unset so other db's also can use this control ;;(sqlite3:set-busy-handler! mdb handler) (db:set-sync mdb) ;; (dbi:exec mdb (conc "PRAGMA synchronous = 0;")) ;; (if (or (and (not exists) |
︙ | ︙ |