| ︙ | | | ︙ | |
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
;; pl-is-port-available
;; pl-get-port-state
;; ;; system
;; get-normalized-cpu-load
;; )
(import scheme posix-groups (chicken base) queues (chicken port) (chicken io) (chicken file) mailbox)
(import srfi-18 pkts matchable regex
typed-records srfi-69 srfi-1
srfi-4 regex-case
(prefix sqlite3 sqlite3:)
foreign
tcp) ;; ulex-netutil)
;;======================================================================
;; D E B U G H E L P E R S
;;======================================================================
(define (dbg> . args)
(with-output-to-port (current-error-port)
|
|
|
>
>
>
>
>
>
>
>
>
|
|
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
|
;; pl-is-port-available
;; pl-get-port-state
;; ;; system
;; get-normalized-cpu-load
;; )
(import scheme posix-groups (chicken base) queues (chicken port) (chicken io) (chicken file) mailbox system-information)
(import srfi-18 pkts matchable regex
typed-records srfi-69 srfi-1
srfi-4 regex-case
(prefix sqlite3 sqlite3:)
(chicken foreign)
(chicken sort)
(chicken process-context posix)
(chicken process-context)
(chicken file posix)
(chicken random)
(chicken pretty-print)
(chicken string)
(chicken time)
(chicken condition)
(chicken tcp)) ;; ulex-netutil)
;;======================================================================
;; D E B U G H E L P E R S
;;======================================================================
(define (dbg> . args)
(with-output-to-port (current-error-port)
|
| ︙ | | | ︙ | |
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
(define (any->number num)
(cond
((number? num) num)
((string? num) (string->number num))
(else num)))
(use trace)
(trace-call-sites #t)
;;======================================================================
;; D A T A B A S E H A N D L I N G
;;======================================================================
;; look in dbhandles for a db, return it, else return #f
;;
|
|
|
|
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
|
(define (any->number num)
(cond
((number? num) num)
((string? num) (string->number num))
(else num)))
;;(use trace)
;;(trace-call-sites #t)
;;======================================================================
;; D A T A B A S E H A N D L I N G
;;======================================================================
;; look in dbhandles for a db, return it, else return #f
;;
|
| ︙ | | | ︙ | |
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
;; open db's hash table
;; returns: the dbdat
;;
(define (open-db acfg fname)
(let* ((fullname (conc (area-dbdir acfg) "/" fname))
(exists (file-exists? fullname))
(write-access (if exists
(file-write-access? fullname)
(file-write-access? (area-dbdir acfg))))
(db (sqlite3:open-database fullname))
(handler (sqlite3:make-busy-timeout 136000))
)
(sqlite3:set-busy-handler! db handler)
(sqlite3:execute db "PRAGMA synchronous = 0;")
(if (not exists) ;; need to init the db
(if write-access
|
|
|
|
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
|
;; open db's hash table
;; returns: the dbdat
;;
(define (open-db acfg fname)
(let* ((fullname (conc (area-dbdir acfg) "/" fname))
(exists (file-exists? fullname))
(write-access (if exists
(file-writable? fullname)
(file-writable? (area-dbdir acfg))))
(db (sqlite3:open-database fullname))
(handler (sqlite3:make-busy-timeout 136000))
)
(sqlite3:set-busy-handler! db handler)
(sqlite3:execute db "PRAGMA synchronous = 0;")
(if (not exists) ;; need to init the db
(if write-access
|
| ︙ | | | ︙ | |
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
|
;;======================================================================
;; W O R K Q U E U E H A N D L I N G
;;======================================================================
(define (register-db-as-mine acfg dbname)
(let ((ht (area-dbs acfg)))
(if (not (hash-table-ref/default ht dbname #f))
(hash-table-set! ht dbname (random 10000)))))
(define (work-queue-add acfg fname witem)
(let* ((work-queue-start (current-milliseconds))
(action (witem-action witem)) ;; NB the action is the index into the rdat actions
(qdat (or (hash-table-ref/default (area-wqueues acfg) fname #f)
(let ((newqdat (make-qdat)))
(hash-table-set! (area-wqueues acfg) fname newqdat)
|
|
|
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
|
;;======================================================================
;; W O R K Q U E U E H A N D L I N G
;;======================================================================
(define (register-db-as-mine acfg dbname)
(let ((ht (area-dbs acfg)))
(if (not (hash-table-ref/default ht dbname #f))
(hash-table-set! ht dbname (pseudo-random-integer 10000)))))
(define (work-queue-add acfg fname witem)
(let* ((work-queue-start (current-milliseconds))
(action (witem-action witem)) ;; NB the action is the index into the rdat actions
(qdat (or (hash-table-ref/default (area-wqueues acfg) fname #f)
(let ((newqdat (make-qdat)))
(hash-table-set! (area-wqueues acfg) fname newqdat)
|
| ︙ | | | ︙ | |