Overview
Comment: | Switched away from json |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
575dfee04c171ea6f6494afb75ba7f39 |
User & Date: | matt on 2013-11-16 23:13:38 |
Other Links: | manifest | tags |
Context
2013-11-16
| ||
23:22 | replace one missed cdb:remote-run call check-in: 8e4249db71 user: matt tags: trunk | |
23:13 | Switched away from json check-in: 575dfee04c user: matt tags: trunk | |
21:12 | Merged minor fixes from v1.55 check-in: 83635d0962 user: matt tags: trunk | |
Changes
Modified api.scm from [6602e90b97] to [3e2760a748].
︙ | ︙ | |||
53 54 55 56 57 58 59 | ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) ((register-run) (apply db:register-run db params)) ((set-tests-state-status) (apply db:set-tests-state-status db params)) | | > > > > > > > > > > > | 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 | ;; RUNS ((get-run-info) (let ((res (apply db:get-run-info db params))) (list (vector-ref res 0) (vector->list (vector-ref res 1))))) ((register-run) (apply db:register-run db params)) ((set-tests-state-status) (apply db:set-tests-state-status db params)) ((get-tests-for-run) (let ((res (apply db:get-tests-for-run db params))) (if (list? res) (map (lambda (x) (if (list? x) (vector->list x) (begin (debug:print 0 "ERROR in remote of get-tests-for-run, not a vector") x))) res) (begin (debug:print 0 "ERROR in remote of get-tests-for-run, not a list") res)))) ((get-test-id) (apply db:get-test-id-not-cached db params)) ((get-tests-for-runs-mindata) (map vector->list (apply db:get-tests-for-runs-mindata db params))) ((get-run-name-from-id) (apply db:get-run-name-from-id db params)) ((delete-run) (apply db:delete-run db params)) ((get-runs) (let* ((res (apply db:get-runs db params)) (hedr (vector-ref res 0)) (data (vector-ref res 1))) |
︙ | ︙ | |||
112 113 114 115 116 117 118 | ;; 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)) | | | | | | | | | > | 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 | ;; 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 (db:string->obj paramsj)) ;; (rmt:json-str->dat paramsj)) (res (api:execute-requests db cmd params))) ;; This can be here but needs controls to ensure it doesn't run more than every 4 seconds ;; (rmt:dat->json-str ;; (if (or (string? res) ;; (list? res) ;; (number? res) ;; (boolean? res)) ;; res ;; (list "ERROR, not string, list, number or boolean" 1 cmd params res))))) (db:obj->string res))) |
Modified db.scm from [b3539e4aa6] to [cba05a0b7c].
︙ | ︙ | |||
1548 1549 1550 1551 1552 1553 1554 | ;;====================================================================== ;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS ;;====================================================================== ;; NOTE: Can remove the regex and base64 encoding for zmq (define (db:obj->string obj) (case *transport-type* | | | | | | 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 | ;;====================================================================== ;; QUEUE UP META, TEST STATUS AND STEPS REMOTE ACCESS ;;====================================================================== ;; NOTE: Can remove the regex and base64 encoding for zmq (define (db:obj->string obj) (case *transport-type* ;; ((fs) obj) ((http fs) (string-substitute (regexp "=") "_" (base64:base64-encode (with-output-to-string (lambda ()(serialize obj)))) #t)) ((zmq)(with-output-to-string (lambda ()(serialize obj)))) (else obj))) (define (db:string->obj msg) (case *transport-type* ;; ((fs) msg) ((http fs) (if (string? msg) (with-input-from-string (base64:base64-decode (string-substitute (regexp "_") "=" msg #t)) (lambda ()(deserialize))) (vector #f #f #f))) ;; crude reply for when things go awry |
︙ | ︙ |
Modified mt.scm from [c0f326ccbf] to [b59cdde8b5].
︙ | ︙ | |||
15 16 17 18 19 20 21 22 23 24 25 26 27 28 | (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses runs)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") | > | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 | (declare (uses db)) (declare (uses common)) (declare (uses items)) (declare (uses runconfig)) (declare (uses tests)) (declare (uses server)) (declare (uses runs)) (declare (uses rmt)) (include "common_records.scm") (include "key_records.scm") (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") |
︙ | ︙ |
Modified rmt.scm from [9538710db7] to [1ecb031848].
︙ | ︙ | |||
35 36 37 38 39 40 41 | ;;====================================================================== ;; cmd is a symbol ;; vars is a json string encoding the parameters for the call ;; (define (rmt:send-receive cmd params) (case *transport-type* | | | | | | 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | ;;====================================================================== ;; 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-aint-here) (debug:print 0 "ERROR: Not yet (re)supported") (exit 1)) ((fs http) (let* ((jparams (db:obj->string params)) ;; (rmt:dat->json-str params)) (res (http-transport:client-api-send-receive *runremote* cmd jparams))) (if res (db:string->obj res) ;; (rmt:json-str->dat res) (begin (debug:print 0 "ERROR: Bad value from http-transport:client-api-send-receive " res) #f)) )) (else (debug:print 0 "ERROR: Transport " *transport-type* " not yet (re)supported") (exit 1)))) |
︙ | ︙ | |||
127 128 129 130 131 132 133 | (rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment))) (define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) (rmt:send-receive 'set-tests-state-status (list run-id testnames currstate currstatus newstate newstatus))) (define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals) | | > > > | > > > | 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 | (rmt:send-receive 'test-set-state-status-by-id (list test-id newstate newstatus newcomment))) (define (rmt:set-tests-state-status run-id testnames currstate currstatus newstate newstatus) (rmt:send-receive 'set-tests-state-status (list run-id testnames currstate currstatus newstate newstatus))) (define (rmt:get-tests-for-run run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals) (let ((res (rmt:send-receive 'get-tests-for-run (list run-id testpatt states statuses offset limit not-in sort-by sort-order qryvals)))) (if (list? res) (map list->vector res) res))) (define (rmt:get-tests-for-runs-mindata run-ids testpatt states status not-in) (let ((res (rmt:send-receive 'get-tests-for-runs-mindata (list run-ids testpatt states status not-in)))) (cond ((list? res)(map list->vector res)) (else res)))) (define (rmt:delete-test-records test-id) (rmt:send-receive 'delete-test-records (list test-id))) (define (rmt:test-set-status-state test-id status state msg) (rmt:send-receive 'test-set-status-state (list test-id status state msg))) |
︙ | ︙ |
Modified tests/Makefile from [f4097c2b49] to [7c208855d9].
︙ | ︙ | |||
156 157 158 159 160 161 162 | touch cleanprep fullprep : cleanprep cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/% cd fullrun;$(BINPATH)/dashboard -rows 15 & dashboard : cleanprep | | < < < | 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | touch cleanprep fullprep : cleanprep cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/% cd fullrun;$(BINPATH)/dashboard -rows 15 & dashboard : cleanprep cd fullrun && $(BINPATH)/dashboard -rows 20 & remove : cd fullrun;$(MEGATEST) -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % clean : rm cleanprep |
︙ | ︙ |