Overview
Comment: | Partial fix for borked server-dat |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | re-re-factor-server |
Files: | files | file ages | folders |
SHA1: |
8ec315acf0f30a7fffff144f51b39c84 |
User & Date: | matt on 2014-02-17 23:04:03 |
Other Links: | branch diff | manifest | tags |
Context
2014-02-18
| ||
06:41 | Merged re-re-factor-server into inmem-per-run-db-per-run-server. NB// There are conflicts in docs/megatest-training.odp and the pdf that need to be manually merged check-in: c8ab0d511e user: mrwellan tags: v1.60 | |
2014-02-17
| ||
23:04 | Partial fix for borked server-dat Closed-Leaf check-in: 8ec315acf0 user: matt tags: re-re-factor-server | |
21:11 | Completed server re-write check-in: cd8a4f1a41 user: matt tags: re-re-factor-server | |
Changes
Modified db.scm from [00935888f7] to [e7471b71a4].
︙ | ︙ | |||
924 925 926 927 928 929 930 931 932 933 934 935 936 937 | (set! res (cons (apply vector a x) res))) db qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) ;; Get all targets from the db ;; (define (db:get-targets dbstruct) (let* ((res '()) (keys (db:get-keys dbstruct)) (header keys) ;; (map key:get-fieldname keys)) (keystr (keys->keystr keys)) | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 | (set! res (cons (apply vector a x) res))) db qrystr ))) (debug:print-info 11 "db:get-runs END qrystr: " qrystr " keypatts: " keypatts " offset: " offset " limit: " count) (vector header res))) ;; db:get-runs-by-patt ;; get runs by list of criteria ;; register a test run with the db ;; ;; Use: (db:get-value-by-header (db:get-header runinfo)(db:get-rows runinfo)) ;; to extract info from the structure returned ;; ;; NOTE: THIS IS COMPLETELY UNFINISHED. IT GOES WITH rmt:get-get-paths-matching-keynames ;; (define (db:get-run-ids-matching dbstruct keynames target res) ;; (define (db:get-runs-by-patt dbstruct keys runnamepatt targpatt offset limit) ;; test-name) (let* ((tmp (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time"))) (keystr (car tmp)) (header (cadr tmp)) (res '()) (key-patt "") (runwildtype (if (substring-index "%" runnamepatt) "like" "glob")) (qry-str #f) (keyvals (if targpatt (keys:target->keyval keys targpatt) '()))) (for-each (lambda (keyval) (let* ((key (car keyval)) (patt (cadr keyval)) (fulkey (conc ":" key)) (wildtype (if (substring-index "%" patt) "like" "glob"))) (if patt (set! key-patt (conc key-patt " AND " key " " wildtype " '" patt "'")) (begin (debug:print 0 "ERROR: searching for runs with no pattern set for " fulkey) (exit 6))))) keyvals) (set! qry-str (conc "SELECT " keystr " FROM runs WHERE state != 'deleted' AND runname " runwildtype " ? " key-patt " ORDER BY event_time " (if limit (conc " LIMIT " limit) "") (if offset (conc " OFFSET " offset) "") ";")) (debug:print-info 4 "runs:get-runs-by-patt qry=" qry-str " " runnamepatt) (db:with-db dbstruct #f #f ;; reads db, does not write to it. (lambda (db) (sqlite3:for-each-row (lambda (a . r) (set! res (cons (list->vector (cons a r)) res))) (db:get-db dbstruct #f) qry-str runnamepatt))) (vector header res))) ;; Get all targets from the db ;; (define (db:get-targets dbstruct) (let* ((res '()) (keys (db:get-keys dbstruct)) (header keys) ;; (map key:get-fieldname keys)) (keystr (keys->keystr keys)) |
︙ | ︙ |
Modified http-transport.scm from [d9e94ba5d7] to [fdad451b60].
︙ | ︙ | |||
309 310 311 312 313 314 315 | (port (cadr server-info)) (last-access 0) (tdb (tasks:open-db)) (server-timeout (let ((tmo (config-lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (string->number tmo)) (* 60 60 (string->number tmo)) | | > | | 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 | (port (cadr server-info)) (last-access 0) (tdb (tasks:open-db)) (server-timeout (let ((tmo (config-lookup *configdat* "server" "timeout"))) (if (and (string? tmo) (string->number tmo)) (* 60 60 (string->number tmo)) ;; (* 3 24 60 60) ;; default to three days (* 60 60) ;; default to one hour )))) ;; ;; set_running ;; (tasks:server-set-state! tdb server-id "running") (let loop ((count 0)) ;; Use this opportunity to sync the inmemdb to db (let ((start-time (current-milliseconds)) |
︙ | ︙ |
Modified rmt.scm from [206f8532c1] to [a5c523b577].
︙ | ︙ | |||
42 43 44 45 46 47 48 | (connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo (let loop ((numtries 100)) (thread-sleep! 1) (let ((res (client:setup run-id))) (if res | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | (connection-info (let ((cinfo (hash-table-ref/default *runremote* run-id #f))) (if cinfo cinfo (let loop ((numtries 100)) (thread-sleep! 1) (let ((res (client:setup run-id))) (if res (hash-table-ref/default *runremote* run-id #f) ;; client:setup filled this in (hopefully) (if (> numtries 0) (loop (- numtries 1)) (begin (debug:print 0 "ERROR: 100 tries and no server, giving up") (exit 1))))))))) (jparams (db:obj->string params)) (res (http-transport:client-api-send-receive run-id connection-info cmd jparams))) |
︙ | ︙ | |||
198 199 200 201 202 203 204 205 | (define (rmt:get-testinfo-state-status run-id test-id) (rmt:send-receive 'get-testinfo-state-status run-id (list run-id test-id))) (define (rmt:test-set-log! run-id test-id logf) (if (string? logf)(rmt:general-call 'test-set-log run-id logf test-id))) (define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname) | > > | > > > | 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 | (define (rmt:get-testinfo-state-status run-id test-id) (rmt:send-receive 'get-testinfo-state-status run-id (list run-id test-id))) (define (rmt:test-set-log! run-id test-id logf) (if (string? logf)(rmt:general-call 'test-set-log run-id logf test-id))) ;; NOTE: This will open and access ALL run databases. ;; (define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname) (let ((run-ids (rmt:get-all-run-ids))) ;; (rmt:get-run-ids-matching keynames target res))) (apply append (lambda (run-id) (rmt:send-receive 'test-get-paths-matching-keynames-target-new (list keynames target res testpatt statepatt statuspatt runname))) run-ids))) (define (rmt:get-run-ids-matching keynames target res) (rmt:send-receive #f 'get-run-ids-matching (list keynames target res))) (define (rmt:get-prereqs-not-met run-id waitons ref-item-path #!key (mode 'normal)) (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode))) (define (rmt:get-count-tests-running-for-run-id run-id) (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id))) ;; Statistical queries |
︙ | ︙ |