| ︙ | | |
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(include "key_records.scm")
(include "run_records.scm")
(define *rundb-mutex* (make-mutex)) ;; prevent problems opening/closing rundb's
(define *number-of-writes* 0)
(define *number-non-write-queries* 0)
;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
;; convert to -inline
(define (db:first-result-default db stmt default . params)
(handle-exceptions
exn
(let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
(if (eq? err-status 'done)
default
(begin
(debug:print 0 "ERROR: query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port))
default)))
(apply sqlite3:first-result db stmt params)))
;; Get/open a database
;; if run-id => get run specific db
;; if #f => get main db
;; if db already open - return inmem
;; if db not open, open inmem, rundb and sync then return inmem
;; inuse gets set automatically for rundb's
;;
|
| ︙ | | |
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
|
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
|
+
-
-
+
+
+
|
;;
(define (db:sync-tables tbls fromdb todb . slave-dbs)
(mutex-lock! *db-sync-mutex*)
(handle-exceptions
exn
(begin
(debug:print 0 "EXCEPTION: database probably overloaded or unreadable in db:sync-tables.")
(print-call-chain (current-error-port))
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print "exn=" (condition->list exn))
(debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn))
(debug:print 0 " src db: " (db:dbdat-get-path fromdb))
(for-each (lambda (dbdat)
(debug:print 0 " dbpath: " (db:dbdat-get-path dbdat)))
(cons todb slave-dbs))
(print-call-chain (current-error-port))
(exit 1))
(if *server-run* ;; we are inside a server
(set! *time-to-exit* #t) ;; let watch dog know that it is time to die.
(exit 1)))
(cond
((not fromdb) (debug:print 3 "WARNING: db:sync-tables called with fromdb missing") -1)
((not todb) (debug:print 3 "WARNING: db:sync-tables called with todb missing") -2)
((not (sqlite3:database? (db:dbdat-get-db fromdb)))
(debug:print 0 "ERROR: db:sync-tables called with fromdb not a database " fromdb) -3)
((not (sqlite3:database? (db:dbdat-get-db todb)))
(debug:print 0 "ERROR: db:sync-tables called with todb not a database " todb) -4)
|
| ︙ | | |
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
|
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
|
+
+
-
-
+
+
+
|
(define (db:test-get-top-process-pid dbstruct run-id test-id)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(db:first-result-default
db
(sqlite3:first-result db "SELECT attemptnum FROM tests WHERE id=?;"
test-id))))
"SELECT attemptnum FROM tests WHERE id=?;"
#f
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
;;
|
| ︙ | | |
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
|
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
|
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
|
;; if the test is not found then clearly the waiton is not met...
;; (if (not ever-seen)(set! result (cons waitontest-name result)))))
(if (not ever-seen)
(set! result (append (if (null? tests)(list waitontest-name) tests) result)))))
waitons)
(delete-duplicates result))))
;;======================================================================
;; SQLITE3 HELPERS
;;======================================================================
;; convert to -inline
(define (db:first-result-default db stmt default . params)
(handle-exceptions
exn
(let ((err-status ((condition-property-accessor 'sqlite3 'status #f) exn)))
;; check for (exn sqlite3) ((condition-property-accessor 'exn 'message) exn)
(if (eq? err-status 'done)
default
(begin
(debug:print 0 "ERROR: query " stmt " failed, params: " params ", error: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain (current-error-port))
default)))
(apply sqlite3:first-result db stmt params)))
|
| ︙ | | |