From 05e7e61d850502639b915f0f3ed1316e81894540 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 30 Nov 2012 17:34:27 -0500 Subject: [PATCH] added #:option to start-transaction, call-with-transaction --- collects/db/base.rkt | 6 +++-- collects/db/private/generic/common.rkt | 10 ++++--- collects/db/private/generic/connect-util.rkt | 6 ++--- collects/db/private/generic/functions.rkt | 12 ++++++--- collects/db/private/generic/interfaces.rkt | 7 ++++- collects/db/private/generic/place-client.rkt | 4 +-- collects/db/private/generic/place-server.rkt | 2 +- collects/db/private/mysql/connection.rkt | 5 +++- collects/db/private/odbc/connection.rkt | 5 +++- collects/db/private/postgresql/connection.rkt | 21 +++++++++------ collects/db/private/sqlite3/connection.rkt | 14 +++++++--- collects/db/scribblings/query.scrbl | 21 ++++++++++++--- collects/tests/db/db/query.rkt | 27 +++++++++++++++++++ 13 files changed, 107 insertions(+), 33 deletions(-) diff --git a/collects/db/base.rkt b/collects/db/base.rkt index e366406da5..e76d1f65b6 100644 --- a/collects/db/base.rkt +++ b/collects/db/base.rkt @@ -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 diff --git a/collects/db/private/generic/common.rkt b/collects/db/private/generic/common.rkt index 379541b956..5f6bcdc576 100644 --- a/collects/db/private/generic/common.rkt +++ b/collects/db/private/generic/common.rkt @@ -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")) diff --git a/collects/db/private/generic/connect-util.rkt b/collects/db/private/generic/connect-util.rkt index f9212d35e0..c7cf3337ff 100644 --- a/collects/db/private/generic/connect-util.rkt +++ b/collects/db/private/generic/connect-util.rkt @@ -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)) diff --git a/collects/db/private/generic/functions.rkt b/collects/db/private/generic/functions.rkt index 0c30671b1d..cd97ec6b20 100644 --- a/collects/db/private/generic/functions.rkt +++ b/collects/db/private/generic/functions.rkt @@ -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? diff --git a/collects/db/private/generic/interfaces.rkt b/collects/db/private/generic/interfaces.rkt index 80b360f90d..9d0253aef5 100644 --- a/collects/db/private/generic/interfaces.rkt +++ b/collects/db/private/generic/interfaces.rkt @@ -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" diff --git a/collects/db/private/generic/place-client.rkt b/collects/db/private/generic/place-client.rkt index b9c29fe001..6de93b5d1f 100644 --- a/collects/db/private/generic/place-client.rkt +++ b/collects/db/private/generic/place-client.rkt @@ -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) diff --git a/collects/db/private/generic/place-server.rkt b/collects/db/private/generic/place-server.rkt index 1b09e044f3..f27b2b0bc2 100644 --- a/collects/db/private/generic/place-server.rkt +++ b/collects/db/private/generic/place-server.rkt @@ -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 diff --git a/collects/db/private/mysql/connection.rkt b/collects/db/private/mysql/connection.rkt index 1f0acb48a3..d0c6488d0b 100644 --- a/collects/db/private/mysql/connection.rkt +++ b/collects/db/private/mysql/connection.rkt @@ -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) diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt index 5f23a1c5c2..68fdc943f4 100644 --- a/collects/db/private/odbc/connection.rkt +++ b/collects/db/private/odbc/connection.rkt @@ -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) diff --git a/collects/db/private/postgresql/connection.rkt b/collects/db/private/postgresql/connection.rkt index e4cb16290a..93bd98e7af 100644 --- a/collects/db/private/postgresql/connection.rkt +++ b/collects/db/private/postgresql/connection.rkt @@ -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)])) diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt index c1899cc247..f548d7e6c4 100644 --- a/collects/db/private/sqlite3/connection.rkt +++ b/collects/db/private/sqlite3/connection.rkt @@ -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 diff --git a/collects/db/scribblings/query.scrbl b/collects/db/scribblings/query.scrbl index 97f280d3a9..d09955a597 100644 --- a/collects/db/scribblings/query.scrbl +++ b/collects/db/scribblings/query.scrbl @@ -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 diff --git a/collects/tests/db/db/query.rkt b/collects/tests/db/db/query.rkt index 1d7c04e16a..5b040977a1 100644 --- a/collects/tests/db/db/query.rkt +++ b/collects/tests/db/db/query.rkt @@ -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?