2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
|
(let* ((dbpath (db:dbfile-path))
(dbname (conc dbpath "/no-sync.db"))
(db-exists (common:file-exists? dbname))
(db (sqlite3:open-database dbname)))
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
(if (not db-exists)
(begin
(sqlite3:execute db "PRAGMA synchronous = 0;")
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
(sqlite3:execute db "PRAGMA journal_mode=WAL;")))
db))
;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
(mutex-lock! *db-access-mutex*)
|
>
|
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
|
(let* ((dbpath (db:dbfile-path))
(dbname (conc dbpath "/no-sync.db"))
(db-exists (common:file-exists? dbname))
(db (sqlite3:open-database dbname)))
(sqlite3:set-busy-handler! db (sqlite3:make-busy-timeout 136000))
(if (not db-exists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS no_sync_metadat (var TEXT,val TEXT, CONSTRAINT no_sync_metadat_constraint UNIQUE (var));")
(sqlite3:execute db "PRAGMA journal_mode=WAL;")))
;; MOVE THIS TABLE CREATION TO THE (begin above in about six months (it is Sep 2020 right now).
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS jobs_queue (id INTEGER PRIMARY KEY, host_type TEXT, cores INTEGER, memory TEXT, vars TEXT, exekey TEXT, cmdline TEXT, state TEXT, event_time INTEGER, last_update INTEGER);")
;; not sure I'll use this next one. I prefer if tests simply append to a file:
;; last-update-seconds cpuload tmpspace rundirspace
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_extra_data (id INTEGER PRIMARY KEY, run_id INTEGER, test_id INTEGER, last_seen_running INTEGER);")
(sqlite3:execute db "PRAGMA synchronous = 0;")
db))
(define (db:no-sync-add-job db-in host-type vars-list exekey cmdline)
(sqlite3:execute (db:no-sync-db db-in) "INSERT INTO jobs_queue (host_type,vars,exekey,cmdline,state,event_time,last_update) VALUES (?,?,?,?,?,?,?);"
host-type
(with-output-to-string
(lambda ()
(write vars-list)))
exekey cmdline "waiting" (current-seconds)(current-seconds)))
;; find next job (waiting longest) that matches host-type - future, we'll find jobs that fit if no exact match
(define (db:no-sync-take-job db-in host-type)
(let* ((db (db:no-sync-db db-in))
(stmt1 "SELECT id,host_type,vars,exekey,cmdline,state,event_time,last_update FROM jobs_queue WHERE host_type=? AND state != 'taken' ORDER BY event_time ASC;")
(stmt1h (sqlite3:prepare db stmt1))
(stmt2 "UPDATE jobs_queue SET state='taken',last_update=? WHERE id=?;")
(stmt2h (sqlite3:prepare db stmt2))
(res (sqlite3:with-transaction
db
(lambda ()
(let* ((matching-jobs (sqlite3:fold-row
(lambda (res . row) ;; id host-type vars exekey state event-time last-update)
(cons row res))
'()
stmt1h
host-type)))
(if (null? matching-jobs)
#f
(let ((choosen-one (let loop ((tal matching-jobs)
(res #f)) ;; put bestest one in here
(if (null? tal)
res
(let ((curr (car tal))
(rem (cdr tal)))
curr) ;; here we will compare with res, if better candidate the loop with curr else loop with res
))))
(if choosen-one ;; we need to mark it as taken
(sqlite3:execute stmt2h (current-seconds) (car choosen-one)))
choosen-one)))))))
(sqlite3:finalize! stmt1h) ;; it'd be nice to cache these and finalize on exit.
(sqlite3:finalize! stmt2h)
res))
;; clean out old jobs in queue, i.e. taken and event_time > 24 hrs ago
;;
(define (db:no-sync-job-records-clean db)
(sqlite3:execute (db:no-sync-db db) "DELETE FROM jobs_queue WHERE state='taken' AND event_time < ?;" (- (current-seconds)(* 24 3600))))
;; if we are not a server create a db handle. this is not finalized
;; so watch for problems. I'm still not clear if it is needed to manually
;; finalize sqlite3 dbs with the sqlite3 egg.
;;
(define (db:no-sync-db db-in)
(mutex-lock! *db-access-mutex*)
|
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
|
(define (db:no-sync-set db var val)
(sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))
(define (db:no-sync-del! db var)
(sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))
(define (db:no-sync-get/default db var default)
(let ((res default))
(sqlite3:for-each-row
(lambda (val)
(set! res val))
(db:no-sync-db db)
"SELECT val FROM no_sync_metadat WHERE var=?;"
var)
(if res
|
|
>
|
|
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
|
(define (db:no-sync-set db var val)
(sqlite3:execute (db:no-sync-db db) "INSERT OR REPLACE INTO no_sync_metadat (var,val) VALUES (?,?);" var val))
(define (db:no-sync-del! db var)
(sqlite3:execute (db:no-sync-db db) "DELETE FROM no_sync_metadat WHERE var=?;" var))
(define (db:no-sync-get/default db-in var default)
(let ((db (db:no-sync-db db-in))
(res default))
(sqlite3:for-each-row
(lambda (val)
(set! res val))
(db:no-sync-db db)
"SELECT val FROM no_sync_metadat WHERE var=?;"
var)
(if res
|