43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
|
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(debug:print 4 "INFO: dbpath=" dbpath)
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
;; (if (config-lookup *configdat* "setup" "synchronous")
;; (begin
;; (debug:print 5 "INFO: Turning off pragma synchronous")
;; (sqlite3:execute db "PRAGMA synchronous = 0;"))
;; (debug:print 5 "INFO: NOT turning off pragma synchronous"))
db))
(define (open-run-close proc idb . params)
(let* ((db (if idb idb (open-db)))
(res (apply proc db params)))
(db (if idb idb (open-db)))
(res (apply proc db params)))
(debug:print 4 "INFO: delta=" *global-delta*)
;; (sqlite3:execute db "PRAGMA synchronous = OFF;")
|
|
|
|
|
|
|
>
>
>
|
>
|
>
>
|
>
>
|
>
|
|
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
|
(handler (make-busy-timeout (if (args:get-arg "-override-timeout")
(string->number (args:get-arg "-override-timeout"))
36000)))) ;; 136000)))
(debug:print 4 "INFO: dbpath=" dbpath)
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(db:initialize db))
(if (equal? (config-lookup *configdat* "setup" "synchronous") "yes")
(begin
(debug:print 5 "INFO: Turning off pragma synchronous")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
(debug:print 5 "INFO: NOT turning off pragma synchronous"))
db))
(define (open-run-close proc idb . params)
(let* ((db (if idb idb (open-db)))
(res #f))
(if (equal? (config-lookup *configdat* "setup" "synchronous") "yes")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
res))
(define *global-delta* 0)
(define *last-global-delta-printed* 0)
(define (open-run-close-measure proc idb . params)
(let* ((start-ms (current-milliseconds))
(db (if idb idb (open-db))))
(if (equal? (config-lookup *configdat* "setup" "synchronous") "yes")
(sqlite3:execute db "PRAGMA synchronous = 0;"))
(set! res (apply proc db params))
(if (not idb)(sqlite3:finalize! db))
;; scale by 10, average with current value.
(set! *global-delta* (/ (+ *global-delta* (/ (- (current-milliseconds) start-ms) 200)) 2))
(if (> (abs (- *last-global-delta-printed* *global-delta*)) 0.08) ;; don't print all the time, only if it changes a bit
(begin
(debug:print 1 "INFO: launch throttle factor=" *global-delta*)
(set! *last-global-delta-printed* *global-delta*)))
res))
(define (db:initialize db)
(let* ((configdat (car *configinfo*)) ;; tut tut, global warning...
(keys (config-get-fields configdat))
(havekeys (> (length keys) 0))
(keystr (keys->keystr keys))
(fieldstr (keys->key/field keys)))
(for-each (lambda (key)
(let ((keyn (vector-ref key 0)))
(if (member (string-downcase keyn)
(list "runname" "state" "status" "owner" "event_time" "comment" "fail_count"
"pass_count"))
(begin
(print "ERROR: your key cannot be named " keyn " as this conflicts with the same named field in the runs table")
(system (conc "rm -f " dbpath))
(exit 1)))))
keys)
(sqlite3:execute db "PRAGMA synchronous = OFF;")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS keys (id INTEGER PRIMARY KEY, fieldname TEXT, fieldtype TEXT, CONSTRAINT keyconstraint UNIQUE (fieldname));")
(for-each (lambda (key)
(sqlite3:execute db "INSERT INTO keys (fieldname,fieldtype) VALUES (?,?);" (key:get-fieldname key)(key:get-fieldtype key)))
keys)
(sqlite3:execute db (conc
"CREATE TABLE IF NOT EXISTS runs (id INTEGER PRIMARY KEY, "
fieldstr (if havekeys "," "")
|