Overview
| Comment: | Fix issues in lock queue and portlogger |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
5bc446ef4342e310ede8b651109aaf34 |
| User & Date: | mrwellan on 2014-11-05 15:33:18 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-11-06
| ||
| 07:33 | Portlogger uses CREATE TABLE IF NOT EXISTS, so no need to test for file - just create the table every time. Added kill server when http-client has issue. Fixed typos in tasks:kill-server check-in: 158a434c54 user: mrwellan tags: v1.60 | |
|
2014-11-05
| ||
| 15:33 | Fix issues in lock queue and portlogger check-in: 5bc446ef43 user: mrwellan tags: v1.60 | |
| 11:05 | Added exception handler to lock-queue call. Added transaction to create db in tdb check-in: 343a1c8579 user: mrwellan tags: v1.60 | |
Changes
Modified lock-queue.scm from [597343223e] to [141b4e4668].
| ︙ | ︙ | |||
8 9 10 11 12 13 14 15 16 17 18 19 20 21 | ;; PURPOSE. (use sqlite3 srfi-18) (import (prefix sqlite3 sqlite3:)) (declare (unit lock-queue)) (declare (uses common)) ;;====================================================================== ;; attempt to prevent overlapping updates of rollup files by queueing ;; update requests in an sqlite db ;;====================================================================== ;;====================================================================== | > | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | ;; PURPOSE. (use sqlite3 srfi-18) (import (prefix sqlite3 sqlite3:)) (declare (unit lock-queue)) (declare (uses common)) (declare (uses tasks)) ;;====================================================================== ;; attempt to prevent overlapping updates of rollup files by queueing ;; update requests in an sqlite db ;;====================================================================== ;;====================================================================== |
| ︙ | ︙ | |||
100 101 102 103 104 105 106 |
;; Actually this should not be needed as mystart cannot be simultaneously less than and test-id same as
(if (not (equal? tid test-id))
(set! res tid)))
(lock-queue:db-dat-get-db dbdat)
"SELECT test_id FROM queue WHERE start_time > ?;" mystart)
res)))
| | | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 |
;; Actually this should not be needed as mystart cannot be simultaneously less than and test-id same as
(if (not (equal? tid test-id))
(set! res tid)))
(lock-queue:db-dat-get-db dbdat)
"SELECT test_id FROM queue WHERE start_time > ?;" mystart)
res)))
(define (lock-queue:get-lock dbdat test-id #!key (count 10)(waiting-msg #f))
(tasks:wait-on-journal (lock-queue:db-dat-get-path dbdat) 1200 remove: #t waiting-msg: "lock-queue:get-lock, waiting on journal")
(let* ((res #f)
(db (lock-queue:db-dat-get-db dbdat))
(lckqry (sqlite3:prepare db "SELECT test_id,run_lock FROM runlocks WHERE run_lock='locked';"))
(mklckqry (sqlite3:prepare db "INSERT INTO runlocks (test_id,run_lock) VALUES (?,'locked');")))
(let ((result
(handle-exceptions
exn
|
| ︙ | ︙ | |||
177 178 179 180 181 182 183 | (sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE run_lock='locked';")) (lock-queue:get-lock dbdat test-it)) ;; returns #f if ok to skip the task ;; returns #t if ok to proceed with task ;; otherwise waits ;; | | > | 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 |
(sqlite3:execute (lock-queue:db-dat-get-db dbdat) "DELETE FROM runlocks WHERE run_lock='locked';"))
(lock-queue:get-lock dbdat test-it))
;; returns #f if ok to skip the task
;; returns #t if ok to proceed with task
;; otherwise waits
;;
(define (lock-queue:wait-turn fname test-id #!key (count 10)(waiting-msg #f))
(let* ((dbdat (lock-queue:open-db fname))
(mystart (current-seconds))
(db (lock-queue:db-dat-get-db dbdat)))
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to find out if it is ok to skip the wait queue. Will try again in few seconds")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(print-call-chain)
(thread-sleep! 10)
(if (> count 0)
(begin
(sqlite3:finalize! db)
(lock-queue:wait-turn fname test-id count: (- count 1)))
(begin
(debug:print 0 "Giving up calls to lock-queue:wait-turn for test-id " test-id " at path " fname ", printing call chain")
|
| ︙ | ︙ |
Modified portlogger.scm from [614321ce45] to [94a24592b0].
| ︙ | ︙ | |||
46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
(handle-exceptions
exn
(begin
;; (release-dot-lock fname)
(debug:print 0 "ERROR: portlogger:open-run-close failed. " proc " " params)
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(print-call-chain))
(let* (;; (lock (obtain-dot-lock fname 2 9 10))
(db (portlogger:open-db fname))
(res (apply proc db params)))
(sqlite3:finalize! db)
;; (release-dot-lock fname)
res))))
| > | 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 |
(handle-exceptions
exn
(begin
;; (release-dot-lock fname)
(debug:print 0 "ERROR: portlogger:open-run-close failed. " proc " " params)
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(debug:print 0 "exn=" (condition->list exn))
(if (file-exists? fname)(delete-file fname)) ;; brutally get rid of it
(print-call-chain))
(let* (;; (lock (obtain-dot-lock fname 2 9 10))
(db (portlogger:open-db fname))
(res (apply proc db params)))
(sqlite3:finalize! db)
;; (release-dot-lock fname)
res))))
|
| ︙ | ︙ |