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))
|
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
|
immediate
flush
sync
set-verbosity
killserver
))
(define (db:login dbstruct calling-path calling-version client-signature)
(if (and (equal? calling-path *toppath*)
(equal? megatest-version calling-version))
(begin
(hash-table-set! *logged-in-clients* client-signature (current-seconds))
'(#t "successful login")) ;; path matches - pass! Should vet the caller at this time ...
(list #f (conc "Login failed due to mismatch paths: " calling-path ", " *toppath*))))
(define (db:general-call db stmtname params)
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
stmtname)
db:queries)))
(if q (car q) #f))))
|
|
>
|
>
>
>
|
>
|
|
|
<
|
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
|
immediate
flush
sync
set-verbosity
killserver
))
(define (db:login dbstruct calling-path calling-version run-id 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 db stmtname params)
(let ((query (let ((q (alist-ref (if (string? stmtname)
(string->symbol stmtname)
stmtname)
db:queries)))
(if q (car q) #f))))
|