From d312744aae50881f83a574fba6d77763431e2664 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 13 Dec 2011 23:51:31 -0700
Subject: [PATCH] db: make debugging easier

---
 collects/db/base.rkt                    | 6 ++++--
 collects/db/main.rkt                    | 6 ++++--
 collects/db/mysql.rkt                   | 3 ++-
 collects/db/postgresql.rkt              | 3 ++-
 collects/db/private/generic/dsn.rkt     | 4 ++--
 collects/db/private/postgresql/main.rkt | 4 +++-
 6 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/collects/db/base.rkt b/collects/db/base.rkt
index 3789658c02..710cfd9186 100644
--- a/collects/db/base.rkt
+++ b/collects/db/base.rkt
@@ -219,7 +219,8 @@
         #:allow-cleartext-password? boolean?
         #:ssl (or/c 'yes 'optional 'no)
         #:notice-handler (or/c 'output 'error)
-        #:notification-handler (or/c 'output 'error))
+        #:notification-handler (or/c 'output 'error)
+        #:debug? any/c)
        data-source?)]
  [mysql-data-source
   (->* ()
@@ -229,7 +230,8 @@
         #:port exact-positive-integer?
         #:socket (or/c string? 'guess)
         #:password (or/c string? #f)
-        #:notice-handler (or/c 'output 'error))
+        #:notice-handler (or/c 'output 'error)
+        #:debug? any/c)
        data-source?)]
  [sqlite3-data-source
   (->* ()
diff --git a/collects/db/main.rkt b/collects/db/main.rkt
index 64035178dc..6d306912dd 100644
--- a/collects/db/main.rkt
+++ b/collects/db/main.rkt
@@ -37,7 +37,8 @@
         #:ssl (or/c 'yes 'no 'optional)
         #:ssl-context ssl-client-context?
         #:notice-handler (or/c 'output 'error output-port? procedure?)
-        #:notification-handler (or/c 'output 'error output-port? procedure?))
+        #:notification-handler (or/c 'output 'error output-port? procedure?)
+        #:debug? any/c)
        connection?)]
  [postgresql-guess-socket-path
   (-> path-string?)]
@@ -54,7 +55,8 @@
         #:socket (or/c path-string? 'guess #f)
         #:ssl (or/c 'yes 'no 'optional)
         #:ssl-context ssl-client-context?
-        #:notice-handler (or/c 'output 'error output-port? procedure?))
+        #:notice-handler (or/c 'output 'error output-port? procedure?)
+        #:debug? any/c)
        connection?)]
  [mysql-guess-socket-path
   (-> path-string?)]
diff --git a/collects/db/mysql.rkt b/collects/db/mysql.rkt
index 400df8e0cd..020264eb3c 100644
--- a/collects/db/mysql.rkt
+++ b/collects/db/mysql.rkt
@@ -15,7 +15,8 @@
         #:socket (or/c path-string? 'guess #f)
         #:ssl (or/c 'yes 'no 'optional)
         #:ssl-context ssl-client-context?
-        #:notice-handler (or/c 'output 'error output-port? procedure?))
+        #:notice-handler (or/c 'output 'error output-port? procedure?)
+        #:debug? any/c)
        connection?)]
  [mysql-guess-socket-path
   (-> path-string?)]
diff --git a/collects/db/postgresql.rkt b/collects/db/postgresql.rkt
index cfa93700b6..e6fac69f8c 100644
--- a/collects/db/postgresql.rkt
+++ b/collects/db/postgresql.rkt
@@ -17,7 +17,8 @@
         #:ssl (or/c 'yes 'no 'optional)
         #:ssl-context ssl-client-context?
         #:notice-handler (or/c 'output 'error output-port? procedure?)
-        #:notification-handler (or/c 'output 'error output-port? procedure?))
+        #:notification-handler (or/c 'output 'error output-port? procedure?)
+        #:debug? any/c)
        connection?)]
  [postgresql-guess-socket-path
   (-> path-string?)]
diff --git a/collects/db/private/generic/dsn.rkt b/collects/db/private/generic/dsn.rkt
index 9d7fd11f43..ed4cf66811 100644
--- a/collects/db/private/generic/dsn.rkt
+++ b/collects/db/private/generic/dsn.rkt
@@ -186,12 +186,12 @@ considered important.
   (mk-specialized 'postgresql-data-source 'postgresql 0
                   '(#:user #:database #:password #:server #:port #:socket
                     #:allow-cleartext-password? #:ssl
-                    #:notice-handler #:notification-handler)))
+                    #:notice-handler #:notification-handler #:debug?)))
 
 (define mysql-data-source
   (mk-specialized 'mysql-data-source 'mysql 0
                   '(#:user #:database #:password #:server #:port #:socket #:ssl
-                    #:notice-handler)))
+                    #:notice-handler #:debug?)))
 
 (define sqlite3-data-source
   (mk-specialized 'sqlite3-data-source 'sqlite3 0
diff --git a/collects/db/private/postgresql/main.rkt b/collects/db/private/postgresql/main.rkt
index 135dbeeb75..1c3a8a9c40 100644
--- a/collects/db/private/postgresql/main.rkt
+++ b/collects/db/private/postgresql/main.rkt
@@ -22,7 +22,8 @@
                                              ((no) #f)
                                              (else (ssl-make-client-context 'sslv3)))]
                             #:notice-handler [notice-handler void]
-                            #:notification-handler [notification-handler void])
+                            #:notification-handler [notification-handler void]
+                            #:debug? [debug? #f])
   (let ([connection-options
          (+ (if (or server port) 1 0)
             (if socket 1 0))]
@@ -41,6 +42,7 @@
                   (notice-handler notice-handler)
                   (notification-handler notification-handler)
                   (allow-cleartext-password? allow-cleartext-password?))])
+      (when debug? (send c debug #t))
       (let-values ([(in out)
                     (cond [socket (unix-socket-connect socket)]
                           [else (let ([server (or server "localhost")]