| ︙ | | |
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
-
+
|
res))))
;;======================================================================
;; K E E P F I L E D B I N dbstruct
;;======================================================================
;; (define (db:get-filedb dbstruct run-id)
;; (let ((db (vector-ref dbstruct 2)))
;; (let ((db (safe-vector-ref dbstruct 2)))
;; (if db
;; db
;; (let ((fdb (filedb:open-db (conc *toplevel* "/db/files.db"))))
;; (vector-set! dbstruct 2 fdb)
;; fdb))))
;;
;; ;; Can also be used to save arbitrary strings
|
| ︙ | | |
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
|
-
+
-
+
|
(for-each
(lambda (fromdat-lst)
(sqlite3:with-transaction
db
(lambda ()
(for-each ;;
(lambda (fromrow)
(let* ((a (vector-ref fromrow 0))
(let* ((a (safe-vector-ref fromrow 0))
(curr (hash-table-ref/default todat a #f))
(same #t))
(let loop ((i 0))
(if (or (not curr)
(not (equal? (vector-ref fromrow i)(vector-ref curr i))))
(not (equal? (safe-vector-ref fromrow i)(safe-vector-ref curr i))))
(set! same #f))
(if (and same
(< i (- num-fields 1)))
(loop (+ i 1))))
(if (not same)
(begin
(apply sqlite3:execute stmth (vector->list fromrow))
|
| ︙ | | |
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
|
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
|
-
-
+
+
|
(tdbdat (tasks:open-db))
(servers (tasks:get-all-servers (db:delay-if-busy tdbdat))))
;; kill servers
(if (member 'killservers options)
(for-each
(lambda (server)
(tasks:server-delete-record (db:delay-if-busy tdbdat) (vector-ref server 0) "dbmigration")
(tasks:kill-server (vector-ref server 2)(vector-ref server 1)))
(tasks:server-delete-record (db:delay-if-busy tdbdat) (safe-vector-ref server 0) "dbmigration")
(tasks:kill-server (safe-vector-ref server 2)(safe-vector-ref server 1)))
servers))
;; clear out junk records
;;
(if (member 'dejunk options)
(begin
(db:delay-if-busy mtdb)
|
| ︙ | | |
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
|
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
|
-
+
-
-
+
+
|
;; look up values in a header/data structure
(define (db:get-value-by-header row header field)
(if (null? header) #f
(let loop ((hed (car header))
(tal (cdr header))
(n 0))
(if (equal? hed field)
(vector-ref row n)
(safe-vector-ref row n)
(if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
;; Accessors for the header/data structure
;; get rows and header from
(define (db:get-header vec)(vector-ref vec 0))
(define (db:get-rows vec)(vector-ref vec 1))
(define (db:get-header vec)(safe-vector-ref vec 0))
(define (db:get-rows vec)(safe-vector-ref vec 1))
;;======================================================================
;; R U N S
;;======================================================================
(define (db:get-run-name-from-id dbstruct run-id)
(db:with-db
|
| ︙ | | |
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
|
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
|
-
-
-
-
-
+
+
+
+
+
-
+
|
((shortlist)(map db:test-short-record->norm res))
((#f) res)
(else res)))))
(define (db:test-short-record->norm inrec)
;; "id,run_id,testname,item_path,state,status"
;; "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
(vector (vector-ref inrec 0) ;; id
(vector-ref inrec 1) ;; run_id
(vector-ref inrec 2) ;; testname
(vector-ref inrec 4) ;; state
(vector-ref inrec 5) ;; status
(vector (safe-vector-ref inrec 0) ;; id
(safe-vector-ref inrec 1) ;; run_id
(safe-vector-ref inrec 2) ;; testname
(safe-vector-ref inrec 4) ;; state
(safe-vector-ref inrec 5) ;; status
-1 "" -1 -1 "" "-"
(vector-ref inrec 3) ;; item-path
(safe-vector-ref inrec 3) ;; item-path
-1 "-" "-"))
(define (db:get-tests-for-run-state-status dbstruct run-id testpatt)
(let* ((res '())
(tests-match-qry (tests:match->sqlqry testpatt))
(qry (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? "
|
| ︙ | | |
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
|
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
|
-
+
|
;; move test ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)
(debug:print-info 0 "Adjusting test ids in megatest.db for run " run-id)
(let ((min-test-id (* run-id 30000)))
(for-each
(lambda (testrec)
(let* ((test-id (vector-ref testrec (db:field->number "id" db:test-record-fields))))
(let* ((test-id (safe-vector-ref testrec (db:field->number "id" db:test-record-fields))))
(db:adj-test-id (db:dbdat-get-db mtdb) min-test-id test-id)))
testrecs)))
;; 1. move test ids into the 30k * run_id range
;; 2. move step ids into the 30k * run_id range
;;
(define (db:prep-megatest.db-for-migration mtdb)
|
| ︙ | | |
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
|
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
|
-
-
+
+
|
;;
;; Run this remotely!!
;;
(define (db:get-matching-previous-test-run-records dbstruct run-id test-name item-path)
(let* ((dbdat (db:get-db dbstruct #f))
(db (db:dbdat-get-db dbdat))
(keys (db:get-keys db))
(selstr (string-intersperse (map (lambda (x)(vector-ref x 0)) keys) ","))
(qrystr (string-intersperse (map (lambda (x)(conc (vector-ref x 0) "=?")) keys) " AND "))
(selstr (string-intersperse (map (lambda (x)(safe-vector-ref x 0)) keys) ","))
(qrystr (string-intersperse (map (lambda (x)(conc (safe-vector-ref x 0) "=?")) keys) " AND "))
(keyvals #f)
(tests-hash (make-hash-table)))
;; first look up the key values from the run selected by run-id
(db:delay-if-busy dbdat)
(sqlite3:for-each-row
(lambda (a . b)
(set! keyvals (cons a b)))
|
| ︙ | | |
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
|
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
|
-
-
-
-
-
-
+
+
+
+
+
+
|
(if pathmod
(let* ((vb (apply vector b))
(keyvals (let loop ((i 0)
(res '()))
(if (>= i numkeys)
res
(loop (+ i 1)
(append res (list (vector-ref vb (+ i 2))))))))
(runname (vector-ref vb 1))
(testname (vector-ref vb (+ 2 numkeys)))
(item-path (vector-ref vb (+ 3 numkeys)))
(final-log (vector-ref vb (+ 7 numkeys)))
(run-dir (vector-ref vb (+ 18 numkeys)))
(append res (list (safe-vector-ref vb (+ i 2))))))))
(runname (safe-vector-ref vb 1))
(testname (safe-vector-ref vb (+ 2 numkeys)))
(item-path (safe-vector-ref vb (+ 3 numkeys)))
(final-log (safe-vector-ref vb (+ 7 numkeys)))
(run-dir (safe-vector-ref vb (+ 18 numkeys)))
(log-fpath (conc run-dir "/" final-log))) ;; (string-intersperse keyvals "/") "/" testname "/" item-path "/"
(debug:print 4 "log: " log-fpath " exists: " (file-exists? log-fpath))
(vector-set! vb (+ 7 numkeys) (if (file-exists? log-fpath)
(let ((newpath (conc pathmod "/"
(string-intersperse keyvals "/")
"/" runname "/" testname "/"
(if (string=? item-path "") "" (conc "/" item-path))
|
| ︙ | | |