db: clean up disconnect

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?)
 

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*

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])

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*

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)