Overview
Comment: | Inmemdb support mostly done. Syncing runs and test_meta table not yet done. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
592afa20f6dcd9bf40e0c998680293a5 |
User & Date: | matt on 2013-11-09 23:01:44 |
Other Links: | manifest | tags |
Context
2013-11-10
| ||
03:43 | Added syncing of runs table check-in: 7693c01883 user: matt tags: trunk | |
2013-11-09
| ||
23:01 | Inmemdb support mostly done. Syncing runs and test_meta table not yet done. check-in: 592afa20f6 user: matt tags: trunk | |
05:45 | Added notes for in-memory db for speed up check-in: 6f83bffb0d user: matt tags: trunk | |
Changes
Modified db.scm from [77cc7e048e] to [88d9652270].
︙ | ︙ | |||
40 41 42 43 44 45 46 47 48 49 50 51 52 53 | ;; type: meta-info, step (define *incoming-writes* '()) (define *completed-writes* (make-hash-table)) (define *incoming-last-time* (current-seconds)) (define *incoming-mutex* (make-mutex)) (define *completed-mutex* (make-mutex)) (define *cache-on* #f) (define (db:set-sync db) (let* ((syncval (config-lookup *configdat* "setup" "synchronous")) (val (cond ;; 0 | OFF | 1 | NORMAL | 2 | FULL; ((not syncval) #f) ((string->number syncval) (let ((val (string->number syncval))) | > > | 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | ;; type: meta-info, step (define *incoming-writes* '()) (define *completed-writes* (make-hash-table)) (define *incoming-last-time* (current-seconds)) (define *incoming-mutex* (make-mutex)) (define *completed-mutex* (make-mutex)) (define *cache-on* #f) (define (db:set-sync db) (let* ((syncval (config-lookup *configdat* "setup" "synchronous")) (val (cond ;; 0 | OFF | 1 | NORMAL | 2 | FULL; ((not syncval) #f) ((string->number syncval) (let ((val (string->number syncval))) |
︙ | ︙ | |||
82 83 84 85 86 87 88 89 90 91 92 93 94 95 | (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv)) (if write-access (sqlite3:set-busy-handler! db handler)) (if (not dbexists) (db:initialize db)) ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once ;; (db:set-sync db) db)) ;; keeping it around for debugging purposes only (define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (if (or *db-write-access* (not (member proc *db:all-write-procs*))) (let* ((db (cond | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | (debug:print-info 11 "open-db, dbpath=" dbpath " argv=" (argv)) (if write-access (sqlite3:set-busy-handler! db handler)) (if (not dbexists) (db:initialize db)) ;; Moving db:set-sync to a call in run.scm - it is a persistent value and only needs to be set once ;; (db:set-sync db) db)) (define (open-in-mem-db) (let ((db (sqlite3:open-database ":memory:"))) (db:initialize db) db)) (define (db:sync-to fromdb todb) ;; strategy ;; 1. Get all run-ids ;; 2. For each run-id ;; a. Sync that run in a transaction (let ((run-ids (db:get-all-run-ids fromdb)) (getstmt (sqlite3:prepare todb "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;")) (putstmt (sqlite3:prepare todb "INSERT OR REPLACE INTO tests (id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? );"))) (for-each (lambda (run-id) (let* ((run-dat (db:get-all-tests-info-by-run-id fromdb run-id)) (curr-tdat #f)) (debug:print 0 "Updating as many as " (length run-dat) " records for run " run-id) (for-each (lambda (tdat) ;; iterate over tests (let ((test-id (vector-ref tdat 0))) (sqlite3:with-transaction todb (lambda () (sqlite3:for-each-row (lambda (a . b) (set! curr-tdat (apply vector a b))) getstmt test-id) (if (not (equal? curr-tdat tdat)) ;; something changed (begin (debug:print 0 "Updating test " test-id) (apply sqlite3:execute putstmt (vector->list tdat))) (begin (debug:print 0 "Not updating test " test-id) ;; (debug:print 0 " tdat: " tdat) ;; (debug:print 0 " curr-tdat: " curr-tdat) ) ))))) run-dat))) run-ids))) ;; keeping it around for debugging purposes only (define (open-run-close-no-exception-handling proc idb . params) (debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params) (if (or *db-write-access* (not (member proc *db:all-write-procs*))) (let* ((db (cond |
︙ | ︙ | |||
711 712 713 714 715 716 717 718 719 720 721 722 723 724 | qryvals) (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res) res) (begin (debug:print 0 "ERROR: Called without all necessary keys") #f)))) ;; replace header and keystr with a call to runs:get-std-run-fields ;; ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; runpatts: patt1,patt2 ... ;; (define (db:get-runs db runpatt count offset keypatts) | > > > > > > > > | 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 | qryvals) (sqlite3:execute db "UPDATE runs SET state=?,status=?,event_time=strftime('%s','now') WHERE id=? AND state='deleted';" state status res) res) (begin (debug:print 0 "ERROR: Called without all necessary keys") #f)))) (define (db:get-all-run-ids db) (let ((res '())) (sqlite3:for-each-row (lambda (run-id) (set! res (cons run-id res))) db "SELECT DISTINCT run_id FROM tests;") res)) ;; replace header and keystr with a call to runs:get-std-run-fields ;; ;; keypatts: ( (KEY1 "abc%def")(KEY2 "%") ) ;; runpatts: patt1,patt2 ... ;; (define (db:get-runs db runpatt count offset keypatts) |
︙ | ︙ | |||
1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 | (define *last-test-cache-delete* (current-seconds)) (define (db:clean-all-caches) (set! *test-info* (make-hash-table)) (set! *test-id-cache* (make-hash-table))) ;; Use db:test-get* to access ;; ;; Get test data using test_id (define (db:get-test-info-by-id db test-id) (if (not test-id) (begin (debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id) | > > > > > > > > > > > > > > | 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 | (define *last-test-cache-delete* (current-seconds)) (define (db:clean-all-caches) (set! *test-info* (make-hash-table)) (set! *test-id-cache* (make-hash-table))) (define (db:get-all-tests-info-by-run-id db run-id) (let ((res '())) (sqlite3:for-each-row (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) res))) db "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=?;" run-id) res)) ;; Get test data using test_id ;; Use db:test-get* to access ;; ;; Get test data using test_id (define (db:get-test-info-by-id db test-id) (if (not test-id) (begin (debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id) |
︙ | ︙ |
Modified http-transport.scm from [d934a1dc41] to [a3d90588fe].
︙ | ︙ | |||
370 371 372 373 374 375 376 377 378 379 380 381 382 383 | (let* ((th2 (make-thread (lambda () (http-transport:run (if (args:get-arg "-server") (args:get-arg "-server") "-"))) "Server run")) (th3 (make-thread http-transport:keep-running "Keep running")) (th1 (make-thread server:write-queue-handler "write queue"))) (thread-start! th2) (thread-start! th3) (thread-start! th1) (set! *didsomething* #t) (thread-join! th2)) (debug:print 0 "ERROR: Failed to setup for megatest"))) (exit))) | > > > > | 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 | (let* ((th2 (make-thread (lambda () (http-transport:run (if (args:get-arg "-server") (args:get-arg "-server") "-"))) "Server run")) (th3 (make-thread http-transport:keep-running "Keep running")) (th1 (make-thread server:write-queue-handler "write queue"))) ;; This is were we set up the database connections (set! *db* (open-db)) (set! *inmemdb* (open-in-mem-db)) (db:sync-to *db* *inmemdb*) (thread-start! th2) (thread-start! th3) (thread-start! th1) (set! *didsomething* #t) (thread-join! th2)) (debug:print 0 "ERROR: Failed to setup for megatest"))) (exit))) |
︙ | ︙ |
Modified launch.scm from [f955cae21f] to [0077f17ad5].
︙ | ︙ | |||
425 426 427 428 429 430 431 | (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override" given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") pathenvvar: "MT_RUN_AREA_HOME")) (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* | > > > > > | | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 | (if (args:get-arg "-config")(args:get-arg "-config") "megatest.config") environ-patt: "env-override" given-toppath: (get-environment-variable "MT_RUN_AREA_HOME") pathenvvar: "MT_RUN_AREA_HOME")) (set! *configdat* (if (car *configinfo*)(car *configinfo*) #f)) (set! *toppath* (if (car *configinfo*)(cadr *configinfo*) #f)) (if *toppath* (let ((dbdir (conc *toppath* "/db"))) (handle-exceptions exn (debug:print 0 "ERROR: failed to create the " dbdir " area for your database files") (if (not (directory-exists? dbdir))(create-directory dbdir))) (setenv "MT_RUN_AREA_HOME" *toppath*)) (debug:print 0 "ERROR: failed to find the top path to your Megatest area.")))) *toppath*) (define (get-best-disk confdat) (let* ((disks (hash-table-ref/default confdat "disks" #f)) (best #f) (bestsize 0)) |
︙ | ︙ |
Modified tasks.scm from [4666e559d1] to [9517782d04].
︙ | ︙ | |||
19 20 21 22 23 24 25 | (include "task_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== (define (tasks:open-db) | | | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 | (include "task_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== (define (tasks:open-db) (let* ((dbpath (conc *toppath* "/db/monitor.db")) (exists (file-exists? dbpath)) (write-access (file-write-access? dbpath)) (mdb (sqlite3:open-database dbpath)) ;; (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 |
︙ | ︙ | |||
62 63 64 65 66 67 68 69 70 71 72 73 74 75 | pubport INTEGER, start_time TIMESTAMP, priority INTEGER, state TEXT, mt_version TEXT, heartbeat TIMESTAMP, transport TEXT, CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));") (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY, server_id INTEGER, pid INTEGER, hostname TEXT, cmdline TEXT, login_time TIMESTAMP, | > | 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | pubport INTEGER, start_time TIMESTAMP, priority INTEGER, state TEXT, mt_version TEXT, heartbeat TIMESTAMP, transport TEXT, run_id INTEGER, CONSTRAINT servers_constraint UNIQUE (pid,hostname,port));") (sqlite3:execute mdb "CREATE TABLE IF NOT EXISTS clients (id INTEGER PRIMARY KEY, server_id INTEGER, pid INTEGER, hostname TEXT, cmdline TEXT, login_time TIMESTAMP, |
︙ | ︙ |