9d34f0f147
Other major changes: - pg code now uses only binary format - pg timestamptz now always UTC (tz = 0), added doc section - added contracts to most pg "can't-convert" errors
120 lines
4.3 KiB
Racket
120 lines
4.3 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
"interfaces.rkt"
|
|
"sql-data.rkt")
|
|
(provide prepared-statement%
|
|
statement:after-exec
|
|
apply-type-handlers)
|
|
|
|
;; A dvec is an opaque value that describes a parameter or result field's type
|
|
;; information. (Usually a vector, thus "dvec" for "description vector".)
|
|
|
|
;; 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 dvec)
|
|
[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-params param-typeids))
|
|
(define/public (get-result-types)
|
|
(send dbsystem describe-fields result-dvecs))
|
|
|
|
;; 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/want-rows fsym obj #f))]
|
|
[(exact-positive-integer? checktype)
|
|
(unless (= (get-result-count) checktype)
|
|
(when close-on-exec? (finalize #t))
|
|
(error/column-count fsym obj checktype (get-result-count) #f))]
|
|
[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")))
|
|
|
|
(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))
|
|
(error/stmt-arity fsym expected-len given-len)))
|
|
(for/list ([handler (in-list param-handlers)]
|
|
[param (in-list params)])
|
|
(cond [(sql-null? param) sql-null]
|
|
[else (handler fsym 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)))))
|