Overview
Comment: | Almost 80% on api conversion for test control panel |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | refactor-api |
Files: | files | file ages | folders |
SHA1: |
82e43c52e7c5fcd7a11e1b2daa1d2ee3 |
User & Date: | matt on 2013-07-28 22:04:09 |
Other Links: | branch diff | manifest | tags |
Context
2013-07-29
| ||
00:12 | Fixed cleaning of steps window after fresh run. Fixd stuck gui on test-panel check-in: 9a62bcf487 user: matt tags: refactor-api | |
2013-07-28
| ||
22:04 | Almost 80% on api conversion for test control panel check-in: 82e43c52e7 user: matt tags: refactor-api | |
20:38 | Added some missing files, more bits of new api in place check-in: d1dbb768c6 user: matt tags: refactor-api | |
Changes
Modified api.scm from [fe9ebd9add] to [c0c3ff9c7b].
︙ | ︙ | |||
12 13 14 15 16 17 18 19 20 21 | (declare (unit api)) (declare (uses rmt)) (declare (uses db)) ;; These are called by the server on recipt of /api calls (define (api:execute-requests db cmd params) (case (string->symbol cmd) ;; json doesn't do vectors, convert to list ((get-test-info-by-id) (vector->list (apply db:get-test-info-by-id db params))) | > > > > < > > > > > | > > > | | 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 | (declare (unit api)) (declare (uses rmt)) (declare (uses db)) ;; These are called by the server on recipt of /api calls (define (api:execute-requests db cmd params) (debug:print-info 1 "api:execute-requests cmd=" cmd " params=" params) (case (string->symbol cmd) ;; KEYS ((get-key-val-pairs) (apply db:get-key-val-pairs db params)) ;; TESTS ;; json doesn't do vectors, convert to list ((get-test-info-by-id) (vector->list (apply db:get-test-info-by-id db params))) ((test-get-rundir-from-test-id) (apply db:test-get-rundir-from-test-id db params)) ((testmeta-get-record) (vector->list (apply db:testmeta-get-record db params))) ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) (else (list "ERROR" 0)))) ;; http-server send-response ;; api:process-request ;; db:* ;; ;; NB// Runs on the server as part of the server loop ;; (define (api:process-request db $) ;; the $ is the request vars proc (let* ((cmd ($ 'cmd)) (paramsj ($ 'params)) (params (rmt:json-str->dat paramsj)) (res (api:execute-requests db cmd params))) (rmt:dat->json-str (if (or (string? res) (list? res) (number? res) (boolean? res)) res (list "ERROR" 1 cmd params res))))) |
Modified dashboard-tests.scm from [a31c4667cf] to [90fbf09413].
︙ | ︙ | |||
355 356 357 358 359 360 361 | (db #f)) (if (not testdat) (begin (debug:print 0 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) (let* ((run-id (if testdat (db:test-get-run_id testdat) #f)) (keydat (if testdat (rmt:get-key-val-pairs run-id) #f)) | | | | 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 | (db #f)) (if (not testdat) (begin (debug:print 0 "ERROR: No test data found for test " test-id ", exiting") (exit 1)) (let* ((run-id (if testdat (db:test-get-run_id testdat) #f)) (keydat (if testdat (rmt:get-key-val-pairs run-id) #f)) (rundat (if testdat (rmt:get-run-info run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-row rundat) (db:get-header rundat) "runname") #f)) ;; These next two are intentional bad values to ensure errors if they should not ;; get filled in properly. (logfile "/this/dir/better/not/exist") (rundir logfile) (teststeps (if testdat (dashboard-tests:get-compressed-steps test-id work-area: rundir) '())) (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) (testname (if testdat (db:test-get-testname testdat) "n/a")) (testmeta (if testdat (let ((tm (rmt:testmeta-get-record testname))) (if tm tm (make-db:testmeta))) (make-db:testmeta))) (keystring (string-intersperse (map (lambda (keyval) ;; (conc ":" (car keyval) " " (cadr keyval))) (cadr keyval)) |
︙ | ︙ | |||
407 408 409 410 411 412 413 | (need-update (or (and (> curr-mod-time db-mod-time) (> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched request-update)) (newtestdat (if need-update (handle-exceptions exn (debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn)) | | | 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 | (need-update (or (and (> curr-mod-time db-mod-time) (> (current-seconds) (+ last-update 2))) ;; every two seconds if db touched request-update)) (newtestdat (if need-update (handle-exceptions exn (debug:print-info 2 "test db access issue: " ((condition-property-accessor 'exn 'message) exn)) (rmt:get-test-info-by-id test-id ))))) (cond ((and need-update newtestdat) (set! testdat newtestdat) (set! teststeps (dashboard-tests:get-compressed-steps test-id work-area: rundir)) (set! logfile (conc (db:test-get-rundir testdat) "/" (db:test-get-final_logf testdat))) (set! rundir (db:test-get-rundir testdat)) (set! testfullname (db:test-get-fullname testdat)) |
︙ | ︙ | |||
584 585 586 587 588 589 590 | (db:test-data-get-value x) (db:test-data-get-expected x) (db:test-data-get-tol x) (db:test-data-get-status x) (db:test-data-get-units x) (db:test-data-get-type x) (db:test-data-get-comment x))) | | | 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 | (db:test-data-get-value x) (db:test-data-get-expected x) (db:test-data-get-tol x) (db:test-data-get-status x) (db:test-data-get-units x) (db:test-data-get-type x) (db:test-data-get-comment x))) (rmt:read-test-data test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) test-data)) ;;(dashboard:run-controls) ))) (iup:attribute-set! tabs "TABTITLE0" "Steps") |
︙ | ︙ |
Modified db.scm from [60af1bba1f] to [62d66dee17].
︙ | ︙ | |||
1913 1914 1915 1916 1917 1918 1919 | (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) (sqlite3:execute tdb "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);" test-id category variable value expected tol units (if comment comment "") status type))) csvlist) (sqlite3:finalize! tdb))))) | < < < < < < < < < < < < < < | 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 | (debug:print 4 "AFTER2: category: " category " variable: " variable " value: " value ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) (sqlite3:execute tdb "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);" test-id category variable value expected tol units (if comment comment "") status type))) csvlist) (sqlite3:finalize! tdb))))) ;; NOTE: Run this local with #f for db !!! (define (db:load-test-data db test-id #!key (work-area #f)) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin (debug:print 4 lin) (db:csv->test-data db test-id lin work-area: work-area) |
︙ | ︙ |
Modified rmt.scm from [96b6893599] to [706a072116].
︙ | ︙ | |||
13 14 15 16 17 18 19 | (declare (unit rmt)) (declare (uses api)) (declare (uses tdb)) (declare (uses http-transport)) ;; | | > > > > | 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | (declare (unit rmt)) (declare (uses api)) (declare (uses tdb)) (declare (uses http-transport)) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; ;;====================================================================== ;; S U P P O R T F U N C T I O N S ;;====================================================================== ;; cmd is a symbol ;; vars is a json string encoding the parameters for the call ;; (define (rmt:send-receive cmd params) (case *transport-type* ((fs) |
︙ | ︙ | |||
48 49 50 51 52 53 54 55 | (json-write dat)))) (define (rmt:json-str->dat json-str) (with-input-from-string json-str (lambda () (json-read)))) ;; | > | > > > > > > > > > > > > < < < > > > > > > > > > > > > > | > > > > > > > > > > | 52 53 54 55 56 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 82 83 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 | (json-write dat)))) (define (rmt:json-str->dat json-str) (with-input-from-string json-str (lambda () (json-read)))) ;;====================================================================== ;; ;; A C T U A L A P I C A L L S ;; ;;====================================================================== ;;====================================================================== ;; K E Y S ;;====================================================================== (define (rmt:get-key-val-pairs run-id) (rmt:send-receive 'get-key-val-pairs (list run-id))) ;;====================================================================== ;; T E S T S ;;====================================================================== (define (rmt:get-test-info-by-id test-id) (list->vector (rmt:send-receive 'get-test-info-by-id (list test-id)))) (define (rmt:test-get-rundir-from-test-id test-id) (rmt:send-receive 'test-get-rundir-from-test-id (list test-id))) (define (rmt:open-test-db-by-test-id test-id #!key (work-area #f)) (let* ((test-path (if (string? work-area) work-area (rmt:test-get-rundir-from-test-id test-id)))) (debug:print 3 "TEST PATH: " test-path) (open-test-db test-path))) (define (rmt:testmeta-get-record testname) (list->vector (rmt:send-receive 'testmeta-get-record (list testname)))) ;;====================================================================== ;; R U N S ;;====================================================================== (define (rmt:get-run-info run-id) (let ((res (rmt:send-receive 'get-run-info (list run-id)))) (vector (car res) (list->vector (cadr res))))) ;;====================================================================== ;; S T E P S ;;====================================================================== ;; Getting steps is more complicated. ;; ;; If given work area ;; 1. Find the testdat.db file ;; 2. Open the testdat.db file and do the query ;; If not given the work area ;; 1. Do a remote call to get the test path ;; 2. Continue as above ;; (define (rmt:get-steps-for-test test-id #!key (work-area #f)) (let* ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area))) (if tdb (tdb:get-steps-data tdb test-id) '()))) ;;====================================================================== ;; T E S T D A T A ;;====================================================================== (define (rmt:read-test-data test-id categorypatt #!key (work-area #f)) (let ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area))) (if tdb (tdb:read-test-data tdb test-id categorypatt) '()))) |
Modified tdb.scm from [c3fefd9321] to [f240d1fcf7].
︙ | ︙ | |||
48 49 50 51 52 53 54 | (lambda (id test-id stepname state status event-time logfile) (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res))) tdb "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-id) (sqlite3:finalize! tdb) (reverse res))) | > > > > > > > > > > | 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 | (lambda (id test-id stepname state status event-time logfile) (set! res (cons (vector id test-id stepname state status event-time (if (string? logfile) logfile "")) res))) tdb "SELECT id,test_id,stepname,state,status,event_time,logfile FROM test_steps WHERE test_id=? ORDER BY id ASC;" ;; event_time DESC,id ASC; test-id) (sqlite3:finalize! tdb) (reverse res))) (define (tdb:read-test-data tdb test-id categorypatt) (let ((res '())) (sqlite3:for-each-row (lambda (id test_id category variable value expected tol units comment status type) (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) tdb "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) (sqlite3:finalize! tdb) (reverse res))) |