34
35
36
37
38
39
40
41
42
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
|
(handle-exceptions
exn
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:open-db fname count: (- count 1))
db))
(sqlite3:execute
db
"CREATE TABLE IF NOT EXISTS queue (
id INTEGER PRIMARY KEY,
test_id INTEGER,
start_time INTEGER,
state TEXT,
CONSTRAINT queue_constraint UNIQUE (test_id));")
(sqlite3:execute
db
"CREATE TABLE IF NOT EXISTS runlocks (
id INTEGER PRIMARY KEY,
test_id INTEGER,
run_lock TEXT,
CONSTRAINT runlock_constraint UNIQUE (run_lock));"))))
(sqlite3:set-busy-handler! db handler)
db))
(define (lock-queue:set-state db test-id newstate #!key (remtries 10))
(handle-exceptions
exn
(if (> remtries 0)
(begin
(debug:print 0 "WARNING: exception on lock-queue:set-state. Trying again in 30 seconds.")
(thread-sleep! 30)
(lock-queue:set-state db test-id newstate remtries: (- remtries 1)))
(begin
(debug:print 0 "ERROR: Failed to set lock state for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
#f))
(sqlite3:execute db "UPDATE queue SET state=? WHERE test_id=?;"
newstate
test-id)))
(define (lock-queue:any-younger? db mystart test-id #!key (remtries 10))
(handle-exceptions
exn
(if (> remtries 0)
(begin
(debug:print 0 "WARNING: exception on lock-queue:any-younger. Trying again in 30 seconds.")
(thread-sleep! 30)
(lock-queue:any-younger? db mystart test-id remtries: (- remtries 1)))
(begin
(debug:print 0 "ERROR: Failed to find younger locks for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
#f))
(let ((res #f))
(sqlite3:for-each-row
|
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
|
34
35
36
37
38
39
40
41
42
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
|
(handle-exceptions
exn
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:open-db fname count: (- count 1))
db))
(sqlite3:with-transaction
db
(lambda ()
(sqlite3:execute
db
"CREATE TABLE IF NOT EXISTS queue (
id INTEGER PRIMARY KEY,
test_id INTEGER,
start_time INTEGER,
state TEXT,
CONSTRAINT queue_constraint UNIQUE (test_id));")
(sqlite3:execute
db
"CREATE TABLE IF NOT EXISTS runlocks (
id INTEGER PRIMARY KEY,
test_id INTEGER,
run_lock TEXT,
CONSTRAINT runlock_constraint UNIQUE (run_lock));"))))))
(sqlite3:set-busy-handler! db handler)
db))
(define (lock-queue:set-state db test-id newstate #!key (remtries 10))
(handle-exceptions
exn
(if (> remtries 0)
(begin
(debug:print 0 "WARNING: exception on lock-queue:set-state. Trying again in 30 seconds.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(thread-sleep! 30)
(lock-queue:set-state db test-id newstate remtries: (- remtries 1)))
(begin
(debug:print 0 "ERROR: Failed to set lock state for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
#f))
(sqlite3:execute db "UPDATE queue SET state=? WHERE test_id=?;"
newstate
test-id)))
(define (lock-queue:any-younger? db mystart test-id #!key (remtries 10))
(handle-exceptions
exn
(if (> remtries 0)
(begin
(debug:print 0 "WARNING: exception on lock-queue:any-younger. Trying again in 30 seconds.")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(thread-sleep! 30)
(lock-queue:any-younger? db mystart test-id remtries: (- remtries 1)))
(begin
(debug:print 0 "ERROR: Failed to find younger locks for test with id " test-id ", error: " ((condition-property-accessor 'exn 'message) exn) ", giving up.")
#f))
(let ((res #f))
(sqlite3:for-each-row
|
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
(let ((res #f)
(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
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:get-lock db test-id count: (- count 1)))
#f)
(sqlite3:with-transaction
db
(lambda ()
|
>
>
|
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
(let ((res #f)
(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
(begin
(debug:print 0 "WARNING: failed to get queue lock. Will try again in a few seconds")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(thread-sleep! 10)
(if (> count 0)
(lock-queue:get-lock db test-id count: (- count 1)))
#f)
(sqlite3:with-transaction
db
(lambda ()
|
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
result)))
(define (lock-queue:release-lock fname test-id #!key (count 10))
(let ((db (lock-queue:open-db fname)))
(handle-exceptions
exn
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:release-lock fname test-id count: (- count 1))
#f))
(sqlite3:execute db "DELETE FROM runlocks WHERE test_id=?;" test-id)
(sqlite3:finalize! db))))
(define (lock-queue:steal-lock db test-id #!key (count 10))
(handle-exceptions
exn
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:steal-lock db test-id count: (- count 1))
#f))
(sqlite3:execute db "DELETE FROM runlocks WHERE run_lock='locked';"))
(lock-queue:get-lock db 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))
(let ((db (lock-queue:open-db fname))
(mystart (current-seconds)))
(handle-exceptions
exn
(begin
(thread-sleep! 10)
(if (> count 0)
(lock-queue:wait-turn fname test-id count: (- count 1))
#f))
(sqlite3:execute
db
"INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
|
>
>
>
>
>
>
|
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
result)))
(define (lock-queue:release-lock fname test-id #!key (count 10))
(let ((db (lock-queue:open-db fname)))
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to release queue lock. Will try again in few seconds")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(thread-sleep! 10)
(if (> count 0)
(lock-queue:release-lock fname test-id count: (- count 1))
#f))
(sqlite3:execute db "DELETE FROM runlocks WHERE test_id=?;" test-id)
(sqlite3:finalize! db))))
(define (lock-queue:steal-lock db test-id #!key (count 10))
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: Failed to steal queue lock. Will try again in few seconds")
(debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn))
(thread-sleep! 10)
(if (> count 0)
(lock-queue:steal-lock db test-id count: (- count 1))
#f))
(sqlite3:execute db "DELETE FROM runlocks WHERE run_lock='locked';"))
(lock-queue:get-lock db 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))
(let ((db (lock-queue:open-db fname))
(mystart (current-seconds)))
(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))
(thread-sleep! 10)
(if (> count 0)
(lock-queue:wait-turn fname test-id count: (- count 1))
#f))
(sqlite3:execute
db
"INSERT OR REPLACE INTO queue (test_id,start_time,state) VALUES (?,?,'waiting');"
|