From a2f75e494d47cd01ce7417a880f0568aaec10a0e Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 26 Aug 2011 16:39:01 -0600
Subject: [PATCH] db: implemented list-tables for odbc (db2, oracle only)  
 added dbms field to odbc connections

---
 collects/db/private/odbc/connection.rkt    | 46 ++++++++++++++++++++--
 collects/db/private/odbc/ffi-constants.rkt |  2 +
 collects/db/private/odbc/ffi.rkt           | 16 +++++++-
 3 files changed, 60 insertions(+), 4 deletions(-)

diff --git a/collects/db/private/odbc/connection.rkt b/collects/db/private/odbc/connection.rkt
index 4b2a1af94d..6dc463463a 100644
--- a/collects/db/private/odbc/connection.rkt
+++ b/collects/db/private/odbc/connection.rkt
@@ -33,6 +33,11 @@
              (handle-status 'odbc-connect status db)
              supported?)))
 
+    (define dbms
+      (let-values ([(status result) (SQLGetInfo-string db SQL_DBMS_NAME)])
+        (handle-status 'odbc-connect status db)
+        result))
+
     (inherit call-with-lock
              call-with-lock*
              add-delayed-call!
@@ -472,10 +477,12 @@
             (when tx-status
               (error/already-in-tx fsym))
             (let* ([ok-levels
-                    (let-values ([(status value) (SQLGetInfo db SQL_TXN_ISOLATION_OPTION)])
+                    (let-values ([(status value)
+                                  (SQLGetInfo db SQL_TXN_ISOLATION_OPTION)])
                       (begin0 value (handle-status fsym status db)))]
                    [default-level
-                     (let-values ([(status value) (SQLGetInfo db SQL_DEFAULT_TXN_ISOLATION)])
+                     (let-values ([(status value)
+                                   (SQLGetInfo db SQL_DEFAULT_TXN_ISOLATION)])
                        (begin0 value (handle-status fsym status db)))]
                    [requested-level
                     (case isolation
@@ -516,7 +523,40 @@
     ;; GetTables
 
     (define/public (list-tables fsym schema)
-      (uerror fsym "unsupported"))
+      (define (no-search)
+        (uerror fsym "schema search path cannot be determined for this DBMS"))
+      (let ([stmt
+             (cond
+              [(regexp-match? #rx"^DB2" dbms)
+               (let* ([schema-cond
+                       (case schema
+                         ((search-or-current current)
+                          "tabschema = CURRENT_SCHEMA")
+                         ((search)
+                          (no-search)))]
+                      [type-cond
+                       ;; FIXME: what table types to include? see docs for SYSCAT.TABLES
+                       "(type = 'T' OR type = 'V')"])
+                 (string-append "SELECT tabname FROM syscat.tables "
+                                "WHERE " type-cond " AND " schema-cond))]
+              [(equal? dbms "Oracle")
+               (let* ([schema-cond
+                       (case schema
+                         ((search-or-current current)
+                          "owner = sys_context('userenv', 'current_schema')")
+                         ((search)
+                          (no-search)))])
+                 (string-append "SELECT table_name AS name FROM sys.all_tables "
+                                "WHERE " schema-cond
+                                "UNION "
+                                "SELECT view_name AS name FROM sys.all_views "
+                                "WHERE " schema-cond))]
+              [else
+               (uerror fsym "not supported for this DBMS")])])
+        (let* ([result (query fsym stmt)]
+               [rows (rows-result-rows result)])
+          (for/list ([row (in-list rows)])
+            (vector-ref row 0)))))
 
     #|
     (define/public (get-tables fsym catalog schema table)
diff --git a/collects/db/private/odbc/ffi-constants.rkt b/collects/db/private/odbc/ffi-constants.rkt
index bb8cb26f3b..b7f96712be 100644
--- a/collects/db/private/odbc/ffi-constants.rkt
+++ b/collects/db/private/odbc/ffi-constants.rkt
@@ -194,3 +194,5 @@
 (define SQL_TXN_READ_COMMITTED   #x2)
 (define SQL_TXN_REPEATABLE_READ  #x4)
 (define SQL_TXN_SERIALIZABLE     #x8)
+
+(define SQL_DBMS_NAME 17)
diff --git a/collects/db/private/odbc/ffi.rkt b/collects/db/private/odbc/ffi.rkt
index 05d640ed02..4c9e520692 100644
--- a/collects/db/private/odbc/ffi.rkt
+++ b/collects/db/private/odbc/ffi.rkt
@@ -116,11 +116,13 @@
 Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
 |#
 
-(define-ffi-definer define-odbc
+(define odbc-lib
   (case (system-type)
     ((windows) (ffi-lib "odbc32.dll"))
     (else (ffi-lib "libodbc" '("1" #f)))))
 
+(define-ffi-definer define-odbc odbc-lib)
+
 (define-odbc SQLAllocHandle
   (_fun (type : _sqlsmallint)
         (parent : _sqlhandle/null)
@@ -156,6 +158,18 @@ Docs at http://msdn.microsoft.com/en-us/library/ms712628%28v=VS.85%29.aspx
         -> (status : _sqlreturn)
         -> (values status value)))
 
+(define SQLGetInfo-string
+  (get-ffi-obj "SQLGetInfo" odbc-lib
+               (_fun (handle info) ::
+                     (handle : _sqlhdbc)
+                     (info : _sqlusmallint)
+                     (value : _bytes = (make-bytes 250))
+                     (250 : _sqlsmallint)
+                     (len : (_ptr o _sqlsmallint))
+                     -> (status : _sqlreturn)
+                     -> (values status
+                                (bytes->string/utf-8 value #f 0 len)))))
+
 (define-odbc SQLGetFunctions
   (_fun (handle : _sqlhdbc)
         (function-id : _sqlusmallint)