diff --git a/collects/db/private/generic/common.rkt b/collects/db/private/generic/common.rkt index d7544844b3..4deaa8b3a2 100644 --- a/collects/db/private/generic/common.rkt +++ b/collects/db/private/generic/common.rkt @@ -77,10 +77,24 @@ ;; ---------------------------------------- -;; Connection base class (locking) +(define debugging% + (class object% + (super-new) + + (field [DEBUG? #f]) + + (define/public (debug debug?) + (set! DEBUG? debug?)) + + (define/public (dprintf fmt . args) + (when DEBUG? (apply fprintf (current-error-port) fmt args))) + + )) + +;; ---------------------------------------- (define locking% - (class object% + (class debugging% ;; == Communication locking @@ -185,24 +199,33 @@ ;; ---------------------------------------- -(define debugging% +(define disconnect% (class locking% + (inherit dprintf + call-with-lock* + connected?) (super-new) - (field [DEBUG? #f]) + ;; disconnect : -> void + (define/public (disconnect) + (when (connected?) + (call-with-lock* 'disconnect + (lambda () (disconnect* #t)) + (lambda () (disconnect* #f)) + #f))) - (define/public (debug debug?) - (set! DEBUG? debug?)) + (define/public (disconnect* politely?) + (dprintf " ** disconnecting~a\n" (if politely? " politely" "")) + (void)) - (define/public (dprintf fmt . args) - (when DEBUG? (apply fprintf (current-error-port) fmt args))) - - )) + (define/override (on-break-within-lock) + (dprintf " ** break occurred within lock\n") + (disconnect* #f)))) ;; ---------------------------------------- (define transactions% - (class debugging% + (class disconnect% (inherit dprintf) (inherit-field DEBUG?) diff --git a/collects/db/private/mysql/connection.rkt b/collects/db/private/mysql/connection.rkt index d305453357..387eba5e46 100644 --- a/collects/db/private/mysql/connection.rkt +++ b/collects/db/private/mysql/connection.rkt @@ -143,23 +143,12 @@ (err next)]) next)) - (define/override (on-break-within-lock) - (disconnect* #f)) - ;; ======================================== ;; Connection management - ;; disconnect : -> void - (define/public (disconnect) - (when (connected?) - (call-with-lock* 'disconnect - (lambda () (disconnect* #t)) - (lambda () (disconnect* #f)) - #f))) - - (define/private (disconnect* politely?) - (dprintf " ** Disconnecting\n") + (define/override (disconnect* politely?) + (super disconnect* politely?) (let ([outport* outport] [inport* inport]) (when outport* diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt index c04452b7cf..f4589de0c5 100644 --- a/collects/db/private/odbc/connection.rkt +++ b/collects/db/private/odbc/connection.rkt @@ -51,9 +51,6 @@ check-valid-tx-status check-statement/tx) - (define/override (on-break-within-lock) - (disconnect*)) - (define/public (get-db fsym) (unless db (error/not-connected fsym)) @@ -479,11 +476,8 @@ (handle-status fsym status stmt) (vector name type size digits))))) - (define/public (disconnect) - (define (go) (disconnect*)) - (call-with-lock* 'disconnect go go #f)) - - (define/private (disconnect*) + (define/override (disconnect* _politely?) + (super disconnect* _politely?) (start-atomic) (let ([db* db] [env* env]) diff --git a/collects/db/private/postgresql/connection.rkt b/collects/db/private/postgresql/connection.rkt index 4c71371135..80cad09c0b 100644 --- a/collects/db/private/postgresql/connection.rkt +++ b/collects/db/private/postgresql/connection.rkt @@ -130,9 +130,6 @@ [(and or-eof? (eof-object? r)) (void)] [else (error/comm fsym "expected ready")]))) - (define/override (on-break-within-lock) - (disconnect* #f)) - ;; == Asynchronous messages ;; handle-async-message : message -> void @@ -157,17 +154,9 @@ ;; == Connection management - ;; disconnect : -> void - (define/public (disconnect) - (when (connected?) - (call-with-lock* 'disconnect - (lambda () (disconnect* #t)) - (lambda () (disconnect* #f)) - #f))) - ;; disconnect* : boolean -> void - (define/private (disconnect* politely?) - (dprintf " ** Disconnecting\n") + (define/override (disconnect* politely?) + (super disconnect* politely?) (let ([outport* outport] [inport* inport]) (when outport* diff --git a/collects/db/private/sqlite3/connection.rkt b/collects/db/private/sqlite3/connection.rkt index a30b59d27e..1fe6c9514e 100644 --- a/collects/db/private/sqlite3/connection.rkt +++ b/collects/db/private/sqlite3/connection.rkt @@ -37,9 +37,6 @@ (define/override (call-with-lock fsym proc) (call-with-lock* fsym (lambda () (set! saved-tx-status (get-tx-status)) (proc)) #f #t)) - (define/override (on-break-within-lock) - (disconnect*)) - (define/private (get-db fsym) (or -db (error/not-connected fsym))) @@ -196,11 +193,8 @@ (hash-set! statement-table pst #t) pst))) - (define/public (disconnect) - (define (go) (disconnect*)) - (call-with-lock* 'disconnect go go #f)) - - (define/private (disconnect*) + (define/override (disconnect* _politely?) + (super disconnect* _politely?) (start-atomic) (let ([db -db]) (set! -db #f)