︙ | | | ︙ | |
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
|
(delete-file* (common:get-sync-lock-filepath))
)
;; clear out junk records
;;
((dejunk)
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
(db:clean-up mtdb)
(db:clean-up tmpdb)
(db:clean-up refndb))
;; sync runs, test_meta etc.
;;
((old2new)
(set! data-synced
|
|
|
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
|
(delete-file* (common:get-sync-lock-filepath))
)
;; clear out junk records
;;
((dejunk)
(db:delay-if-busy mtdb) ;; ok to delay on mtdb
(when (file-write-access? (db:dbdat-get-path mtdb)) (db:clean-up mtdb))
(db:clean-up tmpdb)
(db:clean-up refndb))
;; sync runs, test_meta etc.
;;
((old2new)
(set! data-synced
|
︙ | | | ︙ | |
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
|
(let* ((keyvals (db:get-key-vals dbstruct run-id))
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
thekey))
;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (rmt:get-key-val-pairs run-id))
(kvalues (map cadr keyvals))
(keys (rmt:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
(if (null? keyvals)
'()
(begin
|
|
|
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
|
(let* ((keyvals (db:get-key-vals dbstruct run-id))
(thekey (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/")))
thekey))
;; Get run-ids for runs with same target but different runnames and NOT run-id
;;
(define (db:get-prev-run-ids dbstruct run-id)
(let* ((keyvals (db:get-key-val-pairs dbstruct run-id))
(kvalues (map cadr keyvals))
(keys (rmt:get-keys))
(qrystr (string-intersperse (map (lambda (x)(conc x "=?")) keys) " AND ")))
(let ((prev-run-ids '()))
(if (null? keyvals)
'()
(begin
|
︙ | | | ︙ | |
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
|
(define (db:login dbstruct calling-path calling-version client-signature)
(cond
((not (equal? calling-path *toppath*))
(list #f "Login failed due to mismatch paths: " calling-path ", " *toppath*))
;; ((not (equal? *run-id* run-id))
;; (list #f "Login failed due to mismatch run-id: " run-id ", " *run-id*))
((not (equal? megatest-version calling-version))
(list #f "Login failed due to mismatch megatest version: " calling-version ", " megatest-version))
(else
(hash-table-set! *logged-in-clients* client-signature (current-seconds))
'(#t "successful login"))))
(define (db:general-call dbstruct stmtname params)
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
|
|
|
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
|
(define (db:login dbstruct calling-path calling-version client-signature)
(cond
((not (equal? calling-path *toppath*))
(list #f "Login failed due to mismatch paths: " calling-path ", " *toppath*))
;; ((not (equal? *run-id* run-id))
;; (list #f "Login failed due to mismatch run-id: " run-id ", " *run-id*))
((not (equal? megatest-version calling-version))
(list #t (conc "Login warning due to mismatch megatest version: " calling-version ", " megatest-version)))
(else
(hash-table-set! *logged-in-clients* client-signature (current-seconds))
'(#t "successful login"))))
(define (db:general-call dbstruct stmtname params)
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
|
︙ | | | ︙ | |
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
|
(map (lambda (key val)
(conc key " like '" val "'"))
keynames
(string-split target "/"))
" AND "))
(run-qry (conc "SELECT id FROM runs WHERE " keystr " and runname='" run"'"))
(test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'")))
;(print run-qry)
`((runs . ,(fold-row backcons '() db run-qry))
(tests . ,(fold-row backcons '() db test-qry))
(test_steps . ,(fold-row backcons '() db (conc "SELECT id FROM test_steps WHERE test_id in (" test-qry ")")))
(test_data . ,(fold-row backcons '() db (conc "SELECT id FROM test_data WHERE test_id in (" test-qry ")" )))
))))))
;;======================================================================
|
|
>
|
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
|
(map (lambda (key val)
(conc key " like '" val "'"))
keynames
(string-split target "/"))
" AND "))
(run-qry (conc "SELECT id FROM runs WHERE " keystr " and runname='" run"'"))
(test-qry (conc "SELECT id FROM tests WHERE run_id in (" run-qry ") and testname like '" test-patt "'")))
(print run-qry)
(print test-qry)
`((runs . ,(fold-row backcons '() db run-qry))
(tests . ,(fold-row backcons '() db test-qry))
(test_steps . ,(fold-row backcons '() db (conc "SELECT id FROM test_steps WHERE test_id in (" test-qry ")")))
(test_data . ,(fold-row backcons '() db (conc "SELECT id FROM test_data WHERE test_id in (" test-qry ")" )))
))))))
;;======================================================================
|
︙ | | | ︙ | |