4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
|
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
|
-
+
+
+
-
+
+
-
+
-
+
-
+
|
(dbfile:add-dbdat dbstruct #f dbdat)
(system "rm -rf tempdir")))
;;======================================================================
;; cached writes stuff
;;======================================================================
(define (dbfile:add-cached-write dbstruct proc run-id params)
(define (db:add-cached-write dbstruct proc run-id params)
(debug:print 0 *default-log-port* "Adding cached write for run-id "run-id" params " params)
(mutex-lock! *cached-writes-mutex*)
(let* ((hkey (cons dbstruct run-id))
(cached-writes-queue (hash-table-ref/default *cached-writes-queues* hkey '())))
(hash-table-set! *cached-writes-queues* hkey (cons (list proc params) cached-writes-queue)))
(if (not *cached-writes-flag*)
(begin
(set! *cached-writes-flag* #t)
(thread-start! (make-thread
(lambda ()
(debug:print 0 *default-log-port* "process cached writes thread started.")
(thread-sleep! 1)
(dbfile:process-cached-writes-queue))))))
(db:process-cached-writes-queue))))))
(mutex-unlock! *cached-writes-mutex*))
(define (db:process-cached-writes-queue)
(mutex-lock! *cached-writes-mutex*)
(hash-table-for-each
*cached-writes-queues*
(lambda (hkey writes-list)
(let* ((dbstruct (car hkey))
(run-id (cdr hkey)))
(debug:print 0 *default-log-port* "Processing "(length writes-list)" cached writes for run "run-id)
(db:with-db
dbstruct
run-id
#t
(lambda (db)
(lambda (dbdat db)
(sqlite3:with-transaction
db
(lambda ()
(for-each
(lambda (queued-write)
(match queued-write
((proc params)(apply proc params))
((proc params)(apply proc dbstruct params))
(else (assert #f "BAD queued-write"))))
writes-list))))))))
(set! *cached-writes* #f)
(set! *cached-writes-flag* #f)
(mutex-unlock! *cached-writes-mutex*))
;; (db:extract-ods-file db "outputfile.ods" '(("sysname" "%")("fsname" "%")("datapath" "%")) "%")
;;======================================================================
;; moving watch dogs here due to dependencies
;;======================================================================
|