122 lines
4.5 KiB
Racket
122 lines
4.5 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
"interfaces.rkt"
|
|
"sql-data.rkt")
|
|
(provide prepared-statement%
|
|
statement:after-exec
|
|
apply-type-handlers)
|
|
|
|
;; prepared-statement%
|
|
(define prepared-statement%
|
|
(class* object% (prepared-statement<%>)
|
|
(init ([-owner owner]))
|
|
(init-field handle ;; handle, determined by database system, #f means closed
|
|
close-on-exec? ;; boolean
|
|
param-typeids ;; (listof typeid)
|
|
result-dvecs ;; (listof vector), layout depends on dbsys
|
|
[stmt #f] ;; string/#f
|
|
[stmt-type #f]) ;; usually symbol or #f (see classify-*-sql)
|
|
|
|
(define owner (make-weak-box -owner))
|
|
(define dbsystem (send -owner get-dbsystem))
|
|
|
|
(define param-handlers (send dbsystem get-parameter-handlers param-typeids))
|
|
(define result-typeids (send dbsystem field-dvecs->typeids result-dvecs))
|
|
|
|
(define/public (get-handle) handle)
|
|
(define/public (set-handle h) (set! handle h))
|
|
|
|
(define/public (get-close-on-exec?) close-on-exec?)
|
|
(define/public (after-exec need-lock?)
|
|
(when close-on-exec? ;; indicates ad-hoc prepared statement
|
|
(finalize need-lock?)))
|
|
|
|
(define/public (get-stmt) stmt)
|
|
(define/public (get-stmt-type) stmt-type)
|
|
|
|
(define/public (get-param-count) (length param-typeids))
|
|
(define/public (get-param-typeids) param-typeids)
|
|
|
|
(define/public (get-result-dvecs) result-dvecs)
|
|
(define/public (get-result-count) (length result-dvecs))
|
|
(define/public (get-result-typeids) result-typeids)
|
|
|
|
(define/public (get-param-types)
|
|
(send dbsystem describe-typeids param-typeids))
|
|
(define/public (get-result-types)
|
|
(send dbsystem describe-typeids result-typeids))
|
|
|
|
;; checktype is either #f, 'rows, or exact-positive-integer
|
|
(define/public (check-results fsym checktype obj)
|
|
(cond [(eq? checktype 'rows)
|
|
(unless (positive? (get-result-count))
|
|
(when close-on-exec? (finalize #t))
|
|
(error fsym "expected statement producing rows, got ~e" obj))]
|
|
[(exact-positive-integer? checktype)
|
|
(unless (= (get-result-count) checktype)
|
|
(when close-on-exec? (finalize #t))
|
|
(error fsym
|
|
"expected statement producing rows with ~a ~a, got ~e"
|
|
checktype
|
|
(if (= checktype 1) "column" "columns")
|
|
obj))]
|
|
[else (void)]))
|
|
|
|
(define/public (check-owner fsym c obj)
|
|
(unless handle
|
|
(error fsym "prepared statement is closed"))
|
|
(unless (eq? c (weak-box-value owner))
|
|
(error fsym "prepared statement owned by another connection: ~e" obj)))
|
|
|
|
(define/public (bind fsym params)
|
|
(statement-binding this (apply-type-handlers fsym params param-handlers)))
|
|
|
|
(define/public (finalize need-lock?)
|
|
(when handle
|
|
(let ([owner (weak-box-value owner)])
|
|
(when owner
|
|
(send owner free-statement this need-lock?)))))
|
|
|
|
(define/public (register-finalizer)
|
|
(thread-resume finalizer-thread (current-thread))
|
|
(will-register will-executor this (lambda (pst) (send pst finalize #t))))
|
|
|
|
(super-new)
|
|
(register-finalizer)))
|
|
|
|
(define (statement:after-exec stmt need-lock?)
|
|
(when (statement-binding? stmt)
|
|
(send (statement-binding-pst stmt) after-exec need-lock?)))
|
|
|
|
(define (apply-type-handlers fsym params param-handlers)
|
|
(let ([given-len (length params)]
|
|
[expected-len (length param-handlers)])
|
|
(when (not (= given-len expected-len))
|
|
(uerror fsym "statement requires ~s parameters, given ~s" expected-len given-len)))
|
|
(for/list ([handler (in-list param-handlers)]
|
|
[index (in-naturals)]
|
|
[param (in-list params)])
|
|
(cond [(sql-null? param) sql-null]
|
|
[else (handler fsym index param)])))
|
|
|
|
;; ----
|
|
|
|
(define will-executor (make-will-executor))
|
|
|
|
(define finalizer-thread
|
|
(thread/suspend-to-kill
|
|
(lambda ()
|
|
(let loop ()
|
|
(with-handlers
|
|
([(lambda (e) #t)
|
|
(lambda (e)
|
|
((error-display-handler)
|
|
(cond [(exn? e)
|
|
(format "prepared statement finalizer thread handled exception:\n~a"
|
|
(exn-message e))]
|
|
[else
|
|
"prepared statement finalizer thread handled non-exception"])
|
|
e))])
|
|
(will-execute will-executor))
|
|
(loop)))))
|