Overview
| Comment: | test syncing to postgres now working nicely |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64 |
| Files: | files | file ages | folders |
| SHA1: |
e701e84616ebfb61beeb82ee00209e1d |
| User & Date: | matt on 2017-02-26 16:47:08 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-02-26
| ||
| 17:45 | Added switch -sync-to-pg check-in: 0f744a80ec user: matt tags: v1.64 | |
| 16:47 | test syncing to postgres now working nicely check-in: e701e84616 user: matt tags: v1.64 | |
| 11:27 | Fixed schema issue. transfering/updating individual run entries done. check-in: 266b1a7dc4 user: matt tags: v1.64 | |
Changes
Modified api.scm from [4067424284] to [e21b71bae7].
| ︙ | ︙ | |||
263 264 265 266 267 268 269 |
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
| > | | 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 |
((login) (apply db:login dbstruct params))
((general-call) (let ((stmtname (car params))
(run-id (cadr params))
(realparams (cddr params)))
(db:general-call dbstruct stmtname realparams)))
((sdb-qry) (apply sdb:qry params))
((ping) (current-process-id))
((get-changed-record-ids) (apply db:get-changed-record-ids dbstruct params))
;; TESTMETA
((testmeta-get-record) (apply db:testmeta-get-record dbstruct params))
;; TASKS
((find-task-queue-records) (apply tasks:find-task-queue-records dbstruct params))))))
(if (not writecmd-in-readonly-mode)
(let ((delta-t (- (current-milliseconds)
|
| ︙ | ︙ |
Modified db.scm from [49575f0697] to [7dd9f21d76].
| ︙ | ︙ | |||
2840 2841 2842 2843 2844 2845 2846 |
dbstruct
#f ;; run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
| | | 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 |
dbstruct
#f ;; run-id
#f
(lambda (db)
(let ((res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum archived)))
db
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))))
;; Use db:test-get* to access
|
| ︙ | ︙ | |||
3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 | (set! result (append (if (null? tests) (list waitontest-name) tests) result))) ;; if the test is not found then clearly the waiton is not met... ;; (if (not ever-seen)(set! result (cons waitontest-name result))))) (if (not ever-seen) (set! result (append (if (null? tests)(list waitontest-name) tests) result))))) waitons) (delete-duplicates result)))) ;;====================================================================== ;; Extract ods file from the db ;;====================================================================== ;; NOT REWRITTEN YET!!!!! | > > > > > > > > > > > > > > > > > > > > > | 3885 3886 3887 3888 3889 3890 3891 3892 3893 3894 3895 3896 3897 3898 3899 3900 3901 3902 3903 3904 3905 3906 3907 3908 3909 3910 3911 3912 3913 3914 3915 3916 3917 3918 3919 |
(set! result (append (if (null? tests) (list waitontest-name) tests) result)))
;; if the test is not found then clearly the waiton is not met...
;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
(if (not ever-seen)
(set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
waitons)
(delete-duplicates result))))
;;======================================================================
;; Just for sync, procedures to make sync easy
;;======================================================================
;; get an alist of record ids changed since time since-time
;; '((runs . (1 2 3 ...))(steps . (5 6 7 ...) ...))
;;
(define (db:get-changed-record-ids dbstruct since-time)
;; no transaction, allow the db to be accessed between the big queries
(let ((backcons (lambda (lst item)(cons item lst))))
(db:with-db
dbstruct #f #f
(lambda (db)
`((runs . ,(fold-row backcons '() db "SELECT id FROM runs WHERE last_update>?" since-time))
(tests . ,(fold-row backcons '() db "SELECT id FROM tests WHERE last_update>?" since-time))
(test_steps . ,(fold-row backcons '() db "SELECT id FROM test_steps WHERE last_update>?" since-time))
(test_data . ,(fold-row backcons '() db "SELECT id FROM test_data WHERE last_update>?" since-time))
;; (test_meta . ,(fold-row backcons '() db "SELECT id FROM test_meta WHERE last_update>?" since-time))
(run_stats . ,(fold-row backcons '() db "SELECT id FROM run_stats WHERE last_update>?" since-time))
)))))
;;======================================================================
;; Extract ods file from the db
;;======================================================================
;; NOT REWRITTEN YET!!!!!
|
| ︙ | ︙ |
Modified mt-pg.sql from [22ca83956b] to [90e5f27f4e].
| ︙ | ︙ | |||
57 58 59 60 61 62 63 |
state TEXT,
status TEXT,
count INTEGER,
last_update INTEGER DEFAULT extract(epoch from now()));
CREATE TABLE IF NOT EXISTS test_meta (
id SERIAL PRIMARY KEY,
| | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
state TEXT,
status TEXT,
count INTEGER,
last_update INTEGER DEFAULT extract(epoch from now()));
CREATE TABLE IF NOT EXISTS test_meta (
id SERIAL PRIMARY KEY,
test_name TEXT DEFAULT '',
author TEXT DEFAULT '',
owner TEXT DEFAULT '',
description TEXT DEFAULT '',
reviewed TEXT,
iterated TEXT DEFAULT '',
avg_runtime REAL,
avg_disk REAL,
tags TEXT DEFAULT '',
jobgroup TEXT DEFAULT 'default',
CONSTRAINT test_meta_constraint UNIQUE (test_name));
CREATE TABLE IF NOT EXISTS tasks_queue (
id SERIAL PRIMARY KEY,
action TEXT DEFAULT '',
owner TEXT,
state TEXT DEFAULT 'new',
target TEXT DEFAULT '',
|
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
last_du INTEGER DEFAULT -1,
last_du_time INTEGER DEFAULT extract(epoch from now()),
creation_time INTEGER DEFAULT extract(epoch from now()));
CREATE TABLE IF NOT EXISTS archive_allocations (
id SERIAL PRIMARY KEY,
archive_block_id INTEGER,
| | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
last_du INTEGER DEFAULT -1,
last_du_time INTEGER DEFAULT extract(epoch from now()),
creation_time INTEGER DEFAULT extract(epoch from now()));
CREATE TABLE IF NOT EXISTS archive_allocations (
id SERIAL PRIMARY KEY,
archive_block_id INTEGER,
test_name TEXT,
item_path TEXT,
creation_time INTEGER DEFAULT extract(epoch from now()));
CREATE TABLE IF NOT EXISTS extradat (
id SERIAL PRIMARY KEY,
run_id INTEGER,
key TEXT,
|
| ︙ | ︙ | |||
125 126 127 128 129 130 131 |
"user" TEXT,
accessed TIMESTAMP,
args TEXT);
CREATE TABLE IF NOT EXISTS tests (
id SERIAL PRIMARY KEY,
run_id INTEGER DEFAULT -1,
| | > > > < < < | | 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 |
"user" TEXT,
accessed TIMESTAMP,
args TEXT);
CREATE TABLE IF NOT EXISTS tests (
id SERIAL PRIMARY KEY,
run_id INTEGER DEFAULT -1,
test_name TEXT DEFAULT 'noname',
item_path TEXT DEFAULT '',
state TEXT DEFAULT 'NOT_STARTED',
status TEXT DEFAULT 'FAIL',
host TEXT DEFAULT 'n/a',
cpuload REAL DEFAULT -1,
diskfree INTEGER DEFAULT -1,
uname TEXT DEFAULT 'n/a',
rundir TEXT DEFAULT '/tmp/badname',
shortdir TEXT DEFAULT '/tmp/badname',
attemptnum INTEGER DEFAULT 0,
final_logf TEXT DEFAULT 'logs/final.log',
logdat TEXT DEFAULT '',
run_duration INTEGER DEFAULT 0,
comment TEXT DEFAULT '',
event_time INTEGER DEFAULT extract(epoch from now()),
fail_count INTEGER DEFAULT 0,
pass_count INTEGER DEFAULT 0,
archived INTEGER DEFAULT 0, -- 0=no, > 1=archive block id where test data can be found
last_update INTEGER DEFAULT extract(epoch from now()),
CONSTRAINT testsconstraint UNIQUE (run_id, test_name, item_path));
CREATE TABLE IF NOT EXISTS test_steps (
id SERIAL PRIMARY KEY,
test_id INTEGER,
stepname TEXT,
state TEXT DEFAULT 'NOT_STARTED',
status TEXT DEFAULT 'n/a',
|
| ︙ | ︙ |
Modified rmt.scm from [94c1d184f5] to [ea1ddf50e5].
| ︙ | ︙ | |||
354 355 356 357 358 359 360 361 362 363 364 365 366 367 | ;; add caching if qry is 'getid or 'getstr (rmt:send-receive 'sdb-qry run-id (list qry val))) ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) ;;====================================================================== ;; T E S T M E T A ;;====================================================================== (define (rmt:get-tests-tags) (rmt:send-receive 'get-tests-tags #f '())) | > > > | 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 | ;; add caching if qry is 'getid or 'getstr (rmt:send-receive 'sdb-qry run-id (list qry val))) ;; NOT COMPLETED (define (rmt:runtests user run-id testpatt params) (rmt:send-receive 'runtests run-id testpatt)) (define (rmt:get-changed-record-ids since-time) (rmt:send-receive 'get-changed-record-ids #f (list since-time)) ) ;;====================================================================== ;; T E S T M E T A ;;====================================================================== (define (rmt:get-tests-tags) (rmt:send-receive 'get-tests-tags #f '())) |
| ︙ | ︙ | |||
407 408 409 410 411 412 413 414 | ;; Just some syntatic sugar (define (rmt:register-test run-id test-name item-path) (rmt:general-call 'register-test run-id run-id test-name item-path)) (define (rmt:get-test-id run-id testname item-path) (rmt:send-receive 'get-test-id run-id (list run-id testname item-path))) (define (rmt:get-test-info-by-id run-id test-id) | > > | | 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 |
;; Just some syntatic sugar
(define (rmt:register-test run-id test-name item-path)
(rmt:general-call 'register-test run-id run-id test-name item-path))
(define (rmt:get-test-id run-id testname item-path)
(rmt:send-receive 'get-test-id run-id (list run-id testname item-path)))
;; run-id is NOT used
;;
(define (rmt:get-test-info-by-id run-id test-id)
(if (number? test-id)
(rmt:send-receive 'get-test-info-by-id run-id (list run-id test-id))
(begin
(debug:print 0 *default-log-port* "WARNING: Bad data handed to rmt:get-test-info-by-id run-id=" run-id ", test-id=" test-id)
(print-call-chain (current-error-port))
#f)))
(define (rmt:test-get-rundir-from-test-id run-id test-id)
|
| ︙ | ︙ |
Modified tasks.scm from [d305e36d59] to [d79f0543cb].
| ︙ | ︙ | |||
17 18 19 20 21 22 23 24 25 26 27 28 29 30 | (declare (uses rmt)) (declare (uses common)) (declare (uses pgdb)) ;; (import pgdb) ;; pgdb is a module (include "task_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== ;; wait up to aprox n seconds for a journal to go away ;; | > | 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 | (declare (uses rmt)) (declare (uses common)) (declare (uses pgdb)) ;; (import pgdb) ;; pgdb is a module (include "task_records.scm") (include "db_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== ;; wait up to aprox n seconds for a journal to go away ;; |
| ︙ | ︙ | |||
634 635 636 637 638 639 640 | (if new-run-id (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id)) (hash-table-set! runs-ht run-id new-run-id) ;; ensure key fields are up to date (pgdb:refresh-run-info dbh new-run-id | | > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > | | | > | | > > > > > > > | | 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 |
(if new-run-id
(begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id))
(hash-table-set! runs-ht run-id new-run-id)
;; ensure key fields are up to date
(pgdb:refresh-run-info
dbh
new-run-id
state status owner event-time comment fail-count pass-count)
new-run-id)
(if (handle-exceptions
exn
(begin (print-call-chain) #f)
(pgdb:insert-run
dbh
spec-id target run-name state status owner event-time comment fail-count pass-count)) ;; area-id))
(tasks:run-id->mtpg-run-id dbh cached-info run-id)
#f))))))
(define (tasks:sync-tests-data dbh cached-info test-ids)
(let ((test-ht (hash-table-ref cached-info 'tests)))
(for-each
(lambda (test-id)
(let* ((test-info (rmt:get-test-info-by-id #f test-id))
(run-id (db:test-get-run_id test-info)) ;; look these up in db_records.scm
(test-id (db:test-get-id test-info))
(test-name (db:test-get-testname test-info))
(item-path (db:test-get-item-path test-info))
(state (db:test-get-state test-info))
(status (db:test-get-status test-info))
(host (db:test-get-host test-info))
(cpuload (db:test-get-cpuload test-info))
(diskfree (db:test-get-diskfree test-info))
(uname (db:test-get-uname test-info))
(run-dir (db:test-get-rundir test-info))
(log-file (db:test-get-final_logf test-info))
(run-duration (db:test-get-run_duration test-info))
(comment (db:test-get-comment test-info))
(event-time (db:test-get-event_time test-info))
(archived (db:test-get-archived test-info))
(pgdb-run-id (tasks:run-id->mtpg-run-id dbh cached-info run-id))
(pgdb-test-id (pgdb:get-test-id dbh pgdb-run-id test-name item-path)))
;; "id" "run_id" "testname" "state" "status" "event_time"
;; "host" "cpuload" "diskfree" "uname" "rundir" "item_path"
;; "run_duration" "final_logf" "comment" "shortdir" "attemptnum" "archived"
(if pgdb-test-id ;; have a record
(begin ;; let ((key-name (conc run-id "/" test-name "/" item-path)))
(hash-table-set! test-ht test-id pgdb-test-id)
(pgdb:update-test dbh test-id pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived))
(pgdb:insert-test dbh pgdb-run-id test-name item-path state status host cpuload diskfree uname run-dir log-file run-duration comment event-time archived))
))
test-ids)))
;; get runs changed since last sync
;; (define (tasks:sync-test-data dbh cached-info area-info)
;; (let* ((
(define (tasks:sync-to-postgres configdat)
(let* ((dbh (pgdb:open configdat))
(area-info (pgdb:get-area-by-path dbh *toppath*))
(cached-info (make-hash-table))
(start (current-seconds)))
(for-each (lambda (dtype)
(hash-table-set! cached-info dtype (make-hash-table)))
'(runs targets tests))
(hash-table-set! cached-info 'start start) ;; when done we'll set sync times to this
(if area-info
(let* ((last-sync-time (vector-ref area-info 3))
(changed (rmt:get-changed-record-ids last-sync-time))
(run-ids (alist-ref 'runs changed))
(test-ids (alist-ref 'tests changed))
(test-step-ids (alist-ref 'test_steps changed))
(test-data-ids (alist-ref 'test_data changed))
(run-stat-ids (alist-ref 'run_stats changed)))
(print "area-info: " area-info)
(if (not (null? test-ids))
(tasks:sync-tests-data dbh cached-info test-ids))
)
(if (tasks:set-area dbh configdat)
(tasks:sync-to-postgres configdat)
(begin
(debug:print 0 *default-log-port* "ERROR: unable to create an area record")
#f)))))
|