Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Event expiry and retry |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
66921e6c83cd47e0cfbf0604bdfbd350 |
| User & Date: | alaric 2014-08-10 23:17:40 |
Context
|
2015-11-01
| ||
| 13:29 | Correct handling of timestamps, and deleting temporary files. check-in: 46456b9da0 user: alaric tags: trunk | |
|
2014-08-10
| ||
| 23:17 | Event expiry and retry check-in: 66921e6c83 user: alaric tags: trunk | |
|
2014-07-27
| ||
| 01:45 | As-yet-untested support for event expiry times check-in: e14ae52c5e user: alaric tags: trunk | |
Changes
Changes to speakd-event.scm.
| ︙ | ︙ | |||
11 12 13 14 15 16 17 |
(call-with-database
db-path
(lambda (db)
(check-schema-is-ok db)
(let ((now (current-seconds)))
(exec (sql db "INSERT INTO queue (ts, expiry, priority, event) VALUES (?,?,?,?);")
now
| | | 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
(call-with-database
db-path
(lambda (db)
(check-schema-is-ok db)
(let ((now (current-seconds)))
(exec (sql db "INSERT INTO queue (ts, expiry, priority, event) VALUES (?,?,?,?);")
now
(if ttl (+ now ttl) (+ now 60))
priority
(with-output-to-string (lambda () (write event))))))))
(define opts
(list (args:make-option (p priority) (#:required "priority") "event priority (higher numbers are more urgent)")
(args:make-option (t ttl) (#:optional "time to live") "event expiry time (seconds)")
(args:make-option (d db-path) (#:optional "database path") "database path")
|
| ︙ | ︙ |
Changes to speakd.scm.
| ︙ | ︙ | |||
99 100 101 102 103 104 105 | (id event-id) (timestamp event-timestamp) (priority event-priority) (body event-body)) (define (poll-for-event db) (let* ((s (sql db | | | | 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 |
(id event-id)
(timestamp event-timestamp)
(priority event-priority)
(body event-body))
(define (poll-for-event db)
(let* ((s (sql db
"SELECT id,ts,priority,event FROM queue WHERE retries < 10 AND ts > ? ORDER BY priority DESC, ts ASC LIMIT 1"))
(ev (query fetch s (current-seconds))))
(if (null? ev)
#f
(let* ((id (car ev))
(timestamp (cadr ev))
(priority (caddr ev))
(body (cadddr ev)))
(make-event id timestamp priority
|
| ︙ | ︙ | |||
157 158 159 160 161 162 163 |
(define (exn->string exn)
(sprintf "~a in ~a\n"
((condition-property-accessor 'exn 'message "Unknown error") exn)
(cons ((condition-property-accessor 'exn 'location (void)) exn)
((condition-property-accessor 'exn 'arguments '()) exn))))
(define (log-failure! db ev exn)
| | | | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 |
(define (exn->string exn)
(sprintf "~a in ~a\n"
((condition-property-accessor 'exn 'message "Unknown error") exn)
(cons ((condition-property-accessor 'exn 'location (void)) exn)
((condition-property-accessor 'exn 'arguments '()) exn))))
(define (log-failure! db ev exn)
(let ((s (sql db "UPDATE queue SET retries = retries + 1, error = ?, ts = ? WHERE id = ?")))
(exec s (exn->string exn) (+ (current-seconds) 1) (event-id ev))))
(define (handle-one-event!)
(call-with-database
(db-path)
(lambda (db)
(check-schema-is-ok db)
(delete-expired-events! db)
|
| ︙ | ︙ |