| ︙ | | |
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
|
-
-
+
+
-
+
|
(db:dbdat-get-db todb)
full-sel)
;; first pass implementation, just insert all changed rows
(for-each
(lambda (targdb)
(let* ((db (db:dbdat-get-db targdb))
(stmth (sqlite3:prepare targdb full-ins)))
(db:delay-if-busy targdb)
(stmth (sqlite3:prepare db full-ins)))
;; (db:delay-if-busy targdb) ;; NO WAITING
(sqlite3:with-transaction
targdb
db
(lambda ()
(for-each ;;
(lambda (fromrow)
(let* ((a (vector-ref fromrow 0))
(curr (hash-table-ref/default todat a #f))
(same #t))
(let loop ((i 0))
|
| ︙ | | |
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
|
-
-
+
+
-
+
|
(dbstruct (if toppath (make-dbr:dbstruct path: toppath) #f))
(mtdb (if toppath (db:open-megatest-db)))
(run-ids (if run-ids
run-ids
(if toppath (begin
(db:delay-if-busy mtdb)
(db:get-all-run-ids mtdb)))))
(mdb (tasks:open-db))
(servers (tasks:get-all-servers mdb)))
(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 mdb (vector-ref server 0) "dbmigration")
(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)))
servers))
;; clear out junk records
;;
(if (member 'dejunk options)
(begin
|
| ︙ | | |
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
|
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
|
-
-
+
+
+
|
(frundb (db:dbdat-get-db (db:get-db fromdb run-id))))
(db:delay-if-busy frundb)
(db:delay-if-busy mtdb)
(if (eq? run-id 0)
(db:sync-tables (db:sync-main-list dbstruct) fromdb mtdb)
(db:sync-tables db:sync-tests-only fromdb mtdb))))
run-ids))
(db:close-all dbstruct)
(sqlite3:finalize! mdb)))
;; (db:close-all dbstruct)
;; (sqlite3:finalize! mdb)
))
;; keeping it around for debugging purposes only
(define (open-run-close-no-exception-handling proc idb . params)
(debug:print-info 11 "open-run-close-no-exception-handling START given a db=" (if idb "yes " "no ") ", params=" params)
(if (or *db-write-access*
(not (member proc *db:all-write-procs*)))
(let* ((db (cond
|
| ︙ | | |
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
|
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
|
+
-
-
+
+
|
pid test-id))))
(define (db:test-get-top-process-pid dbstruct run-id test-id)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(sqlite3:first-result db "SELECT attemptnum FROM tests WHERE id=?;"
test-id)))
(sqlite3:first-result db "SELECT attemptnum FROM tests WHERE id=?;"
test-id))))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum"))
;; fields *must* be a non-empty list
;;
|
| ︙ | | |
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
|
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
|
+
|
(if (null? tal)
(map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests
(loop (car tal)(cdr tal))))))))))
(define (db:delay-if-busy dbdat #!key (count 6))
(if dbdat
(let* ((dbpath (db:dbdat-get-path dbdat))
(db (db:dbdat-get-db dbdat)) ;; we'll return this so (db:delay--if-busy can be called inline
(dbfj (conc dbpath "-journal")))
(if (file-exists? dbfj)
(case count
((6)
(thread-sleep! 0.2)
(db:delay-if-busy count: 5))
((5)
|
| ︙ | | |
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
|
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
|
-
+
+
+
|
(thread-sleep! 3.2)
(db:delay-if-busy count: 1))
((1)
(thread-sleep! 6.4)
(db:delay-if-busy count: 0))
(else
(debug:print-info 0 "delaying db access due to high database load.")
(thread-sleep! 12.8)))))))
(thread-sleep! 12.8))))
db)
"bogus result from db:delay-if-busy"))
(define (db:test-get-records-for-index-file dbstruct run-id test-name)
(let ((res '()))
(db:with-db
dbstruct
run-id
#f
|
| ︙ | | |