#lang racket/base
(require racket/class
"interfaces.rkt")
(provide kill-safe-connection%)
(define kill-safe-connection%
(class* object% (connection<%>)
(init connection)
(define req-channel (make-channel))
(define safe-thread
(thread/suspend-to-kill
(lambda ()
(let loop ()
(let* ([req (channel-get req-channel)]
[proc (car req)]
[return-box (cadr req)]
[return-sema (caddr req)])
(set-box! return-box
(with-handlers ([(lambda (e) #t)
(lambda (e) (cons 'raise e))])
(cons 'values
(call-with-values (lambda () (proc connection)) list))))
(semaphore-post return-sema)
(loop))))))
(define (call proc)
(thread-resume safe-thread)
(let ([return-box (box #f)]
[return-sema (make-semaphore 0)])
(channel-put req-channel (list proc return-box return-sema))
(semaphore-wait return-sema)
(let ([result (unbox return-box)])
(case (car result)
((values)
(apply values (cdr result)))
((raise)
(raise (cdr result)))))))
(define/public (connected?)
(call (lambda (obj) (send obj connected?))))
(define/public (disconnect)
(call (lambda (obj) (send obj disconnect))))
(define/public (get-dbsystem)
(call (lambda (obj) (send obj get-dbsystem))))
(define/public (query fsym stmt collector)
(call (lambda (obj) (send obj query fsym stmt collector))))
(define/public (prepare fsym stmt close-on-exec?)
(call (lambda (obj) (send obj prepare fsym stmt close-on-exec?))))
(define/public (free-statement stmt)
(call (lambda (obj) (send obj free-statement stmt))))
(super-new)))