Automated commit for debian release 6.7.2-1

[clsql.git] / sql / generic-odbc.lisp

diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp
index 766606035a3c2cc2f64e6e5d3f194becce3ff28e..706e4cf87c1d61588b57bd34727a9ac6fd46be8b 100644 (file)
--- a/sql/generic-odbc.lisp
+++ b/sql/generic-odbc.lisp
@@ -20,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)
@@ -44,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
-                                        (db-type (eql :mssql)))
-  (declare (ignore args database))
-  "BIT")
-
-(defmethod database-get-type-specifier ((type (eql 'generalized-boolean)) args database
+(defmethod database-get-type-specifier ((type symbol) 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
 
@@ -94,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)))
@@ -245,8 +210,9 @@ on schema since that's what tends to be exposed. Some DBs like mssql
   (%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
@@ -256,8 +222,11 @@ on schema since that's what tends to be exposed. Some DBs like mssql
     (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
@@ -278,3 +247,17 @@ on schema since that's what tends to be exposed. Some DBs like mssql
                           (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)