suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

db: clean up common tx code

Browse Source
This commit is contained in:
Ryan Culpepper 2012-01-14 22:35:50 -07:00
parent 654ccb277f
commit 6fe7e65ff0
5 changed files with 64 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
collects/db/private/generic/common.rkt
View File

@ -167,23 +167,28 @@
(define transactions%
(class locking%
(inherit call-with-lock)
#|
A transaction created via SQL is "unmanaged".
A transaction created via start-tx, call-with-tx is "managed".
FIXME: eliminate distinction, if possible.
- currently: tx-stack != null means tx-status != #f
- would also like: tx-stack = null iff tx-status = #f
tx-status : #f, #t, 'invalid
Indicates whether in a transaction (managed or unmanaged) and if
transaction is valid or invalid.
tx-stack : (list (cons string boolean) ... (cons #f boolean))
Represents the "managed" transaction stack.
If tx-status = #f, then tx-stack = null (except temporarily,
within lock). But it is possible for tx-status != #f and
tx-stack = null; that indicates an unmanaged tx.
|#
;; tx-status : #f, #t, 'invalid
(field [tx-status #f])
(define tx-status #f)
(define tx-stack null)
;; tx-stack : (list (cons string boolean) ... (cons #f boolean)
;; Represents the "managed" transaction stack.
(field [tx-stack null])
(define/public (get-tx-status) tx-status)
(define/public (set-tx-status! fsym s)
(set! tx-status s))
;; check-valid-tx-status : symbol -> void
(define/public (check-valid-tx-status fsym)
@ -192,16 +197,19 @@
;; ----
;; (inherit call-with-lock)
(define/override (call-with-lock fsym proc)
(super call-with-lock fsym
(lambda ()
(begin0 (proc)
(when (and (eq? tx-status #f) (not (null? tx-stack)))
(error/internal fsym "managed transaction unexpectedly closed"))))))
;; ----
(define/public (transaction-status fsym)
(call-with-lock fsym (lambda () tx-status)))
;; transaction-nesting : -> (U #f 'unmanaged 'top-level 'nested)
(define/public (transaction-nesting)
(cond [(eq? tx-status #f) #f]
[(null? tx-stack) 'unmanaged]
[(null? (cdr tx-stack)) 'top-level]
[else 'nested]))
(define/public (tx-state->string)
(string-append (case (transaction-nesting)
((#f) "not in transaction")
@ -213,6 +221,12 @@
(string-join savepoints ", "))
""))))
(define/private (transaction-nesting)
(cond [(eq? tx-status #f) #f]
[(null? tx-stack) 'unmanaged]
[(null? (cdr tx-stack)) 'top-level]
[else 'nested]))
;; ----
(define/public (start-transaction fsym isolation cwt?)
@ -296,8 +310,8 @@
if in "managed" top-level transaction (no "managed" savepoints):
- START not allowed
- COMMIT, ROLLBACK not allowed (for now!)
- SAVEPOINT allowed
- RELEASE TO, ROLLBACK TO allowed
- SAVEPOINT not allowed (for consistency, for ease of stmt cache)
- RELEASE TO, ROLLBACK TO not allowed (for consistency, for ease of stmt cache)
- implicit-commit not allowed
if in nested "managed" transaction (impl as "managed" savepoint):
@ -321,15 +335,7 @@
(void))
((unmanaged)
(void))
((top-level)
(case stmt-type
((start)
(no! " within transaction"))
((commit rollback
implicit-commit)
(no! " within managed transaction"))
(else (void))))
((nested)
((top-level nested)
(case stmt-type
((start)
(no! " within transaction"))
@ -337,7 +343,7 @@
savepoint prepare-transaction
release-savepoint rollback-savepoint
implicit-commit)
(no! " in managed transaction"))
(no! " within managed transaction"))
(else (void))))))
(super-new)))

15
collects/db/private/mysql/connection.rkt
View File

@ -26,8 +26,9 @@
call-with-lock*
add-delayed-call!
check-valid-tx-status
get-tx-status
set-tx-status!
check-statement/tx)
(inherit-field tx-status)
(super-new)
@ -97,15 +98,13 @@
(eprintf " << ~s\n" next))
;; Update transaction status (see Transactions below)
(when (ok-packet? next)
(set! tx-status
(bitwise-bit-set? (ok-packet-server-status next) 0)))
(set-tx-status! fsym (bitwise-bit-set? (ok-packet-server-status next) 0)))
(when (eof-packet? next)
(set! tx-status
(bitwise-bit-set? (eof-packet-server-status next) 0)))
(set-tx-status! fsym (bitwise-bit-set? (eof-packet-server-status next) 0)))
(when (error-packet? next)
(when tx-status
(when (member (error-packet-errno next) '(1213 1205))
(set! tx-status 'invalid))))
(when (member (error-packet-errno next) '(1213 1205))
(when (get-tx-status)
(set-tx-status! fsym 'invalid))))
(match next
[(? handshake-packet?)
(advance 'handshake)]

11
collects/db/private/odbc/connection.rkt
View File

@ -43,9 +43,10 @@
(inherit call-with-lock
call-with-lock*
add-delayed-call!
get-tx-status
set-tx-status!
check-valid-tx-status
check-statement/tx)
(inherit-field tx-status)
(define/public (get-db fsym)
(unless db
@ -539,7 +540,7 @@
(handle-status fsym status db)))
(let ([status (SQLSetConnectAttr db SQL_ATTR_AUTOCOMMIT SQL_AUTOCOMMIT_OFF)])
(handle-status fsym status db)
(set! tx-status #t)
(set-tx-status! fsym #t)
(void)))
(define/override (end-transaction* fsym mode _savepoint)
@ -553,7 +554,7 @@
(let ([status (SQLSetConnectAttr db SQL_ATTR_AUTOCOMMIT SQL_AUTOCOMMIT_ON)])
(handle-status fsym status db)
;; commit/rollback can fail; don't change status until possible error handled
(set! tx-status #f)
(set-tx-status! fsym #f)
(void))))
;; GetTables
@ -637,8 +638,8 @@
;; if the driver does one-statement rollback.
(let ([db db])
(when db
(when tx-status
(set! tx-status 'invalid))))
(when (get-tx-status)
(set-tx-status! who 'invalid))))
(raise e))
;; Be careful: shouldn't do rollback before we call handle-status*
;; just in case rollback destroys statement with diagnostic records.

13
collects/db/private/postgresql/connection.rkt
View File

@ -34,11 +34,11 @@
(inherit call-with-lock
call-with-lock*
add-delayed-call!
get-tx-status
set-tx-status!
check-valid-tx-status
check-statement/tx
transaction-nesting
tx-state->string)
(inherit-field tx-status)
(super-new)
@ -105,10 +105,11 @@
(let ([r (recv-message fsym)])
(cond [(ReadyForQuery? r)
;; Update transaction status
(case (ReadyForQuery-transaction-status r)
((idle) (set! tx-status #f))
((transaction) (set! tx-status #t))
((failed) (set! tx-status 'invalid)))]
(set-tx-status! fsym
(case (ReadyForQuery-transaction-status r)
((idle) #f)
((transaction) #t)
((failed) 'invalid)))]
[(and or-eof? (eof-object? r)) (void)]
[else (error/comm fsym "expected ready")])))

17
collects/db/private/sqlite3/connection.rkt
View File

@ -25,12 +25,13 @@
(inherit call-with-lock*
add-delayed-call!
get-tx-status
set-tx-status!
check-valid-tx-status
check-statement/tx)
(inherit-field tx-status)
(define/override (call-with-lock fsym proc)
(call-with-lock* fsym (lambda () (set! saved-tx-status tx-status) (proc)) #f #t))
(call-with-lock* fsym (lambda () (set! saved-tx-status (get-tx-status)) (proc)) #f #t))
(define/private (get-db fsym)
(or -db (error/not-connected fsym)))
@ -63,8 +64,8 @@
[result
(or cursor?
(step* fsym db stmt #f +inf.0))])
(unless (eq? tx-status 'invalid)
(set! tx-status (get-tx-status)))
(unless (eq? (get-tx-status) 'invalid)
(set-tx-status! fsym (read-tx-status)))
(unless cursor? (send pst after-exec #f))
(cond [(and (pair? info) (not cursor?))
(rows-result info result)]
@ -223,7 +224,7 @@
;; http://www.sqlite.org/lang_transaction.html
(define/private (get-tx-status)
(define/private (read-tx-status)
(not (sqlite3_get_autocommit -db)))
(define/override (start-transaction* fsym isolation)
@ -252,7 +253,7 @@
[else
(internal-query1 fsym "ROLLBACK TRANSACTION")])
;; remove 'invalid status, if necessary
(set! tx-status (get-tx-status))))
(set-tx-status! fsym (read-tx-status))))
(void))
;; name-counter : number
@ -295,8 +296,8 @@
;; Can't figure out how to test...
(define/private (handle-status who s)
(when (memv s maybe-rollback-status-list)
(when (and saved-tx-status -db (not (get-tx-status))) ;; was in trans, now not
(set! tx-status 'invalid)))
(when (and saved-tx-status -db (not (read-tx-status))) ;; was in trans, now not
(set-tx-status! who 'invalid)))
(handle-status* who s -db))
;; ----