X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fgeneric-odbc.lisp;h=bd4d01cda033156bd6c0ff4aa0e6346cfca2a819;hb=925a29060928f773d4bc7d8e6bdd13c97e0ef65a;hp=91310fbf9124e132c5851360c03725558ff17ad3;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246;p=clsql.git diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp index 91310fb..bd4d01c 100644 --- a/sql/generic-odbc.lisp +++ b/sql/generic-odbc.lisp @@ -1,8 +1,6 @@ ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; -;;;; $Id$ -;;;; ;;;; Generic ODBC layer, used by db-odbc and db-aodbc backends ;;;; ;;;; This file is part of CLSQL. @@ -79,6 +77,11 @@ (declare (ignore args database)) "DATETIME") +(defmethod database-get-type-specifier ((type (eql 'date)) args database + (db-type (eql :mssql))) + (declare (ignore args database)) + "SMALLDATETIME") + (defmethod database-get-type-specifier ((type (eql 'boolean)) args database (db-type (eql :mssql))) (declare (ignore args database)) @@ -207,36 +210,44 @@ (setf (car rest) elem)) list)))) -(defmethod database-list-tables ((database generic-odbc-database) - &key (owner nil)) - (declare (ignore owner)) + +(defun %database-list-* (database type owner) + "Internal function used by database-list-tables and +database-list-views" (multiple-value-bind (rows col-names) (funcall (list-all-database-tables-fn database) :db (odbc-conn database)) (declare (ignore col-names)) + ;; http://msdn.microsoft.com/en-us/library/ms711831%28VS.85%29.aspx ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager ;; TABLE_NAME in third column, TABLE_TYPE in fourth column - (loop for row in rows - when (and (not (string-equal "information_schema" (nth 1 row))) - (string-equal "TABLE" (nth 3 row)) - (not (and (eq :mssql (database-underlying-type database)) - (string-equal "dtproperties" (nth 2 row))))) - collect (nth 2 row)))) + (loop for (category schema name ttype . rest) in rows + when (and (string-equal type ttype) + (or (null owner) (string-equal owner schema)) + ;; unless requesting by name, skip system schema + (not (and (null owner) + (member schema '("information_schema" "sys") + :test #'string-equal))) + ;; skip system specific tables in mssql2000 + (not (and (eql :mssql (database-underlying-type database)) + (member name '("dtproperties" "sysconstraints" + "syssegments") + :test #'string-equal)))) + collect name))) + +(defmethod database-list-tables ((database generic-odbc-database) + &key (owner nil)) + "Since ODBC doesn't expose the owner we use that parameter to filter +on schema since that's what tends to be exposed. Some DBs like mssql +2000 conflate the two so at least there it works nicely." + (%database-list-* database "TABLE" owner)) (defmethod database-list-views ((database generic-odbc-database) - &key (owner nil)) - (declare (ignore owner)) - (multiple-value-bind (rows col-names) - (funcall (list-all-database-tables-fn database) :db (odbc-conn database)) - (declare (ignore col-names)) - ;; TABLE_SCHEM is hard-coded in second column by ODBC Driver Manager - ;; TABLE_NAME in third column, TABLE_TYPE in fourth column - (loop for row in rows - when (and (not (string-equal "information_schema" (nth 1 row))) - (string-equal "VIEW" (nth 3 row)) - (not (and (eq :mssql (database-underlying-type database)) - (member (nth 2 row) '("sysconstraints" "syssegments") :test #'string-equal)))) - collect (nth 2 row)))) + &key (owner nil)) + "Since ODBC doesn't expose the owner we use that parameter to filter +on schema since that's what tends to be exposed. Some DBs like mssql +2000 conflate the two so at least there it works nicely." + (%database-list-* database "VIEW" owner)) (defmethod database-list-attributes ((table string) (database generic-odbc-database)