X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fgeneric-odbc.lisp;h=706e4cf87c1d61588b57bd34727a9ac6fd46be8b;hp=91310fbf9124e132c5851360c03725558ff17ad3;hb=0b35694f3659e5ee739ea72ce74d798c3f0ddb73;hpb=e567409d9fff3f7231c2a0bb69b345e19de2b246 diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp index 91310fb..706e4cf 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. @@ -22,7 +20,8 @@ (close-query-fn :reader close-query-fn) (fetch-row :reader fetch-row-fn) (list-all-database-tables-fn :reader list-all-database-tables-fn) - (list-all-table-columns-fn :reader list-all-table-columns-fn)) + (list-all-table-columns-fn :reader list-all-table-columns-fn) + (odbc-db-type :accessor database-odbc-db-type :initarg :odbc-db-type )) (:documentation "Encapsulate same behavior across odbc and aodbc backends.")) (defmethod initialize-instance :after ((db generic-odbc-database) @@ -46,48 +45,22 @@ (slot-value db 'list-all-table-columns-fn) (intern (symbol-name '#:list-all-table-columns) pkg)))) -;;; Object methods - -(defmethod read-sql-value (val (type (eql 'boolean)) - (database generic-odbc-database) - (db-type (eql :postgresql))) - (if (string= "0" val) nil t)) - -(defmethod read-sql-value (val (type (eql 'generalized-boolean)) - (database generic-odbc-database) - (db-type (eql :postgresql))) - (if (string= "0" val) nil t)) - -(defmethod read-sql-value (val (type (eql 'boolean)) database - (db-type (eql :mssql))) - (declare (ignore database)) - (etypecase val - (string (if (string= "0" val) nil t)) - (integer (if (zerop val) nil t)))) - -(defmethod read-sql-value (val (type (eql 'generalized-boolean)) database - (db-type (eql :mssql))) - (declare (ignore database)) - (etypecase val - (string (if (string= "0" val) nil t)) - (integer (if (zerop val) nil t)))) - ;;; Type methods -(defmethod database-get-type-specifier ((type (eql 'wall-time)) args database - (db-type (eql :mssql))) - (declare (ignore args database)) - "DATETIME") - -(defmethod database-get-type-specifier ((type (eql 'boolean)) args database +(defmethod database-get-type-specifier ((type symbol) args database (db-type (eql :mssql))) - (declare (ignore args database)) - "BIT") - -(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database - (db-type (eql :mssql))) - (declare (ignore args database)) - "BIT") + "Special database types for MSSQL backends" + (declare (ignore database db-type args)) + (case type + (wall-time "DATETIME") + (date "SMALLDATETIME") + ((generalized-boolean boolean) "BIT") + ((longchar text) "ntext") + ((varchar string) + (if args + (format nil "NVARCHAR(~A)" (car args)) + (format nil "NVARCHAR(~D)" *default-string-length*))) + (t (call-next-method)))) ;;; Generation of SQL strings from lisp expressions @@ -96,16 +69,6 @@ (:mssql "1") (t "'Y'"))) -(defmethod database-output-sql-as-type ((type (eql 'boolean)) val database - (db-type (eql :mssql))) - (declare (ignore database)) - (if val 1 0)) - -(defmethod database-output-sql-as-type ((type (eql 'generalized-boolean)) val database - (db-type (eql :mssql))) - (declare (ignore database)) - (if val 1 0)) - ;;; Database backend capabilities (defmethod db-type-use-fully-qualified-column-on-drop-index? ((db-type (eql :mssql))) @@ -207,40 +170,49 @@ (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) - &key (owner nil)) +(defmethod database-list-attributes ((table %database-identifier) (database generic-odbc-database) + &key (owner nil) + &aux (table (unescaped-database-identifier table))) (declare (ignore owner)) (multiple-value-bind (rows col-names) (funcall (list-all-table-columns-fn database) table @@ -250,8 +222,11 @@ (loop for row in rows collect (fourth row)))) -(defmethod database-attribute-type ((attribute string) (table string) (database generic-odbc-database) - &key (owner nil)) +(defmethod database-attribute-type ((attribute %database-identifier) (table %database-identifier) + (database generic-odbc-database) + &key (owner nil) + &aux (table (unescaped-database-identifier table)) + (attribute (unescaped-database-identifier attribute))) (declare (ignore owner)) (multiple-value-bind (rows col-names) (funcall (list-all-table-columns-fn database) table @@ -272,3 +247,17 @@ (when size (parse-integer size)) (when precision (parse-integer precision)) (when scale (parse-integer scale)))))))) + +(defmethod database-last-auto-increment-id + ((database generic-odbc-database) table column) + (case (database-underlying-type database) + (:mssql + (first (clsql:query "SELECT SCOPE_IDENTITY()" + :flatp t + :database database + :result-types '(:int)))) + (t (if (next-method-p) + (call-next-method))))) + +(defmethod clsql-sys:db-type-has-auto-increment? ((db-underlying-type (eql :mssql))) + t)