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

added #:option to start-transaction, call-with-transaction

Browse Source
This commit is contained in:
Ryan Culpepper 2012-11-30 17:34:27 -05:00
parent 702676030b
commit 05e7e61d85
13 changed files with 107 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/db/base.rkt
View File

@ -189,7 +189,8 @@
[start-transaction
(->* (connection?)
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f)
#:option any/c)
void?)]
[commit-transaction
(-> connection? void?)]
@ -201,7 +202,8 @@
(-> connection? boolean?)]
[call-with-transaction
(->* (connection? (-> any))
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f)
#:option any/c)
any)]
[prop:statement

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

@ -297,21 +297,23 @@
;; ----
(define/public (start-transaction fsym isolation cwt?)
(define/public (start-transaction fsym isolation option cwt?)
(call-with-lock fsym
(lambda ()
(check-valid-tx-status fsym)
(cond [(not tx-status)
(start-transaction* fsym isolation)
(start-transaction* fsym isolation option)
(set! tx-stack (list (cons #f cwt?)))]
[else ;; in transaction
(unless (eq? isolation #f)
(error/invalid-nested-isolation fsym isolation))
(let ([savepoint (start-transaction* fsym 'nested)])
(when option
(error/nested-tx-option fsym option))
(let ([savepoint (start-transaction* fsym 'nested #f)])
(set! tx-stack (cons (cons savepoint cwt?) tx-stack)))])))
(void))
(define/public (start-transaction* fsym isolation)
(define/public (start-transaction* fsym isolation option)
;; returns string (savepoint name) if isolation = 'nested, #f otherwise
(error/internal fsym "not implemented"))

6
collects/db/private/generic/connect-util.rkt
View File

@ -91,7 +91,7 @@
(get-base)
(free-statement stmt need-lock?)
(transaction-status fsym)
(start-transaction fsym isolation cwt?)
(start-transaction fsym isolation option cwt?)
(end-transaction fsym mode cwt?)
(list-tables fsym schema))
@ -177,7 +177,7 @@
(#t '_ (get-dbsystem))
(#t '_ (query fsym stmt cursor?))
(#t '_ (fetch/cursor fsym stmt fetch-size))
(#t '_ (start-transaction fsym isolation cwt?))
(#t '_ (start-transaction fsym isolation option cwt?))
(#f (void) (end-transaction fsym mode cwt?))
(#f #f (transaction-status fsym))
(#t '_ (list-tables fsym schema)))
@ -340,7 +340,7 @@
(get-base)
(free-statement stmt need-lock?)
(transaction-status fsym)
(start-transaction fsym isolation cwt?)
(start-transaction fsym isolation option cwt?)
(end-transaction fsym mode cwt?)
(list-tables fsym schema))

12
collects/db/private/generic/functions.rkt
View File

@ -271,8 +271,10 @@
;; ========================================
(define (start-transaction c #:isolation [isolation #f])
(send c start-transaction 'start-transaction isolation #f))
(define (start-transaction c
#:isolation [isolation #f]
#:option [option #f])
(send c start-transaction 'start-transaction isolation option #f))
(define (commit-transaction c)
(send c end-transaction 'commit-transaction 'commit #f))
@ -280,8 +282,10 @@
(define (rollback-transaction c)
(send c end-transaction 'rollback-transaction 'rollback #f))
(define (call-with-transaction c proc #:isolation [isolation #f])
(send c start-transaction '|call-with-transaction (start)| isolation #t)
(define (call-with-transaction c proc
#:isolation [isolation #f]
#:option [option #f])
(send c start-transaction '|call-with-transaction (start)| isolation option #t)
(with-handlers ([exn?
(lambda (e1)
(with-handlers ([exn?

7
collects/db/private/generic/interfaces.rkt
View File

@ -44,7 +44,7 @@
;; in start-tx and end-tx, the final boolean arg indicates whether the
;; transaction is managed manually (#f) or by call-with-tx (#t)
start-transaction ;; symbol (U 'serializable ...) boolean -> void
start-transaction ;; symbol (U 'serializable ...) any boolean -> void
end-transaction ;; symbol (U 'commit 'rollback) boolean -> void
transaction-status ;; symbol -> (U boolean 'invalid)
free-statement)) ;; prepared-statement<%> boolean -> void
@ -190,6 +190,7 @@ producing plain old exn:fail.
error/tx-bad-stmt
error/unbalanced-tx
error/unclosed-tx
error/nested-tx-option
error/exn-in-rollback
error/stmt-arity
error/stmt
@ -240,6 +241,10 @@ producing plain old exn:fail.
"statement type" stmt-type-string
"transaction state" tx-state))
(define (error/nested-tx-option fsym option)
(raise-misc-error fsym "option not allowed for nested transaction"
'("option" value) option))
(define (error/exn-in-rollback fsym e1 e2)
(raise-misc-error fsym "error during rollback"
#:continued "secondary error occurred during rollback triggered by primary error"

4
collects/db/private/generic/place-client.rkt
View File

@ -85,8 +85,8 @@
(call 'fetch/cursor fsym (cursor-result-extra cursor) fetch-size))
(define/public (transaction-status fsym)
(call 'transaction-status fsym))
(define/public (start-transaction fsym iso cwt?)
(call 'start-transaction fsym iso cwt?))
(define/public (start-transaction fsym iso option cwt?)
(call 'start-transaction fsym iso option cwt?))
(define/public (end-transaction fsym mode cwt?)
(call 'end-transaction fsym mode cwt?))
(define/public (list-tables fsym schema)

2
collects/db/private/generic/place-server.rkt
View File

@ -114,7 +114,7 @@ server -> client: (or (list boolean 'values result ...)
(forward-methods (connected?)
(prepare w s m)
(list-tables w s)
(start-transaction w m c)
(start-transaction w m o c)
(end-transaction w m c)
(transaction-status w))]))
(lambda results

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

@ -505,13 +505,16 @@
;; - transaction deadlock = 1213 (ER_LOCK_DEADLOCK)
;; - lock wait timeout (depends on config) = 1205 (ER_LOCK_WAIT_TIMEOUT)
(define/override (start-transaction* fsym isolation)
(define/override (start-transaction* fsym isolation option)
(cond [(eq? isolation 'nested)
(let ([savepoint (generate-name)])
(query1 fsym (format "SAVEPOINT ~a" savepoint) #f #t)
savepoint)]
[else
(let ([isolation-level (isolation-symbol->string isolation)])
(when option
;; No options supported
(raise-argument-error fsym "#f" option))
(when isolation-level
(query1 fsym (format "SET TRANSACTION ISOLATION LEVEL ~a" isolation-level) #f #t))
(query1 fsym "START TRANSACTION" #f #t)

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

@ -517,10 +517,13 @@
;; Transactions
(define/override (start-transaction* fsym isolation)
(define/override (start-transaction* fsym isolation option)
(when (eq? isolation 'nested)
(raise-misc-error fsym "already in transaction"
#:continued "nested transactions not supported for ODBC connections"))
(when option
;; No options supported
(raise-argument-error fsym "#f" option))
(let* ([db (get-db fsym)]
[ok-levels
(let-values ([(status value)

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

@ -539,19 +539,24 @@
;; == Transactions
(define/override (start-transaction* fsym isolation)
(define/override (start-transaction* fsym isolation option)
(cond [(eq? isolation 'nested)
;; FIXME: error if option != #f ?
(let ([savepoint (generate-name)])
(internal-query1 fsym (format "SAVEPOINT ~a" savepoint))
savepoint)]
[else
(let* ([isolation-level (isolation-symbol->string isolation)]
[stmt (if isolation-level
(string-append "BEGIN WORK ISOLATION LEVEL " isolation-level)
"BEGIN WORK")])
;; FIXME: also support
;; 'read-only => "READ ONLY"
;; 'read-write => "READ WRITE"
(let* ([isolation-part (isolation-symbol->string isolation)]
[option-part
(case option
((read-write) " READ WRITE")
((read-only) " READ ONLY")
((#f) #f)
(else (raise-argument-error fsym "(or/c 'read-write 'read-only #f)" option)))]
[stmt (string-append "BEGIN WORK"
(if isolation-part " ISOLATION LEVEL " "")
(or isolation-part "")
(or option-part ""))])
(internal-query1 fsym stmt)
#f)]))

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

@ -248,7 +248,7 @@
(define/private (read-tx-status)
(not (sqlite3_get_autocommit -db)))
(define/override (start-transaction* fsym isolation)
(define/override (start-transaction* fsym isolation option)
;; Isolation level can be set to READ UNCOMMITTED via pragma, but
;; ignored in all but a few cases, don't bother.
;; FIXME: modes are DEFERRED | IMMEDIATE | EXCLUSIVE
@ -257,8 +257,16 @@
(internal-query1 fsym (format "SAVEPOINT ~a" savepoint))
savepoint)]
[else
(internal-query1 fsym "BEGIN TRANSACTION")
#f]))
;; Note: pragma read_uncommitted irrelevant, since we don't use
;; the shared page cache.
(let ([sql
(case option
((deferred #f) "BEGIN TRANSACTION")
((immediate) "BEGIN IMMEDIATE TRANSACTION")
((exclusive) "BEGIN EXCLUSIVE TRANSACTION")
(else (raise-argument-error fsym "(or/c 'deferred 'immediate 'exclusive #f)" option)))])
(internal-query1 fsym sql)
#f)]))
(define/override (end-transaction* fsym mode savepoint)
(case mode

21
collects/db/scribblings/query.scrbl
View File

@ -629,7 +629,8 @@ implicitly rolled back.
'read-committed
'read-uncommitted
#f)
#f])
#f]
[#:option option any/c #f])
void?]{
Starts a transaction with isolation @racket[isolation-level]. If
@ -637,8 +638,21 @@ implicitly rolled back.
database-dependent; it may be a default isolation level or it may be
the isolation level of the previous transaction.
The behavior of @racket[option] depends on the database system:
@itemlist[
@item{PostgreSQL supports @racket['read-only] and @racket['read-write]
for the @hyperlink["http://www.postgresql.org/docs/9.0/static/sql-set-transaction.html"]{corresponding
transaction options}.}
@item{SQLite supports @racket['deferred], @racket['immediate], and
@racket['exclusive] for the @hyperlink["http://www.sqlite.org/lang_transaction.html"]{corresponding
locking modes}.}
@item{MySQL and ODBC no not support any options.}
]
If @racket[option] is not supported, an exception is raised.
If @racket[c] is already in a transaction, @racket[isolation-level]
must be @racket[#f], and a @tech{nested transaction} is opened.
and @racket[option] must both be @racket[#f], and a @tech{nested
transaction} is opened.
}
@defproc[(commit-transaction [c connection?]) void?]{
@ -691,7 +705,8 @@ implicitly rolled back.
'read-committed
'read-uncommitted
#f)
#f])
#f]
[#:option option any/c #f])
any]{
Calls @racket[proc] in the context of a new transaction with

27
collects/tests/db/db/query.rkt
View File

@ -308,6 +308,19 @@
(check-equal? (in-transaction? c) #t)
(check-pred void? (commit-transaction c))
(check-equal? (in-transaction? c) #f)))
(test-case "start w/ option"
(with-connection c
(for ([option
(case dbsys
((postgresql) '(read-only read-write))
((sqlite3) '(deferred immediate exclusive))
(else '()))])
(check-pred void? (start-transaction c #:option option))
(check-equal? (in-transaction? c) #t)
(check-pred void? (commit-transaction c))
(check-equal? (in-transaction? c) #f))
(check-exn #rx"^start-transaction: "
(lambda () (start-transaction c #:option 'no-such-option)))))
(test-case "start, rollback"
(with-connection c
(check-pred void? (start-transaction c))
@ -394,6 +407,20 @@
(check-equal? (call-with-transaction c
(lambda () (query-value c (select-val "'abc'"))))
"abc")))
(test-case "cwt w/ option"
(with-connection c
(for ([option
(case dbsys
((postgresql) '(read-only read-write))
((sqlite3) '(deferred immediate exclusive))
(else '()))])
(check-equal? (call-with-transaction c #:option option
(lambda () (query-value c (select-val "'abc'"))))
"abc"))
(check-exn #rx"^call-with-transaction"
(lambda ()
(call-with-transaction c #:option 'no-such-option
(lambda () (query-value c (select-val "'abc'"))))))))
(test-case "cwt w/ error"
(with-connection c
(check-exn exn:fail?