fixed a bugs in list-attribute(s|-types) in fddl that I introduced

with %database-identifier stuff (essentially I need unquoted column
names but was passing around quoted ones).  Pass around
%database-identifiers instead and only get the un/escaped version as
you are about to stick it in a query.

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index 857bcd5ec985c78dc863bc8cd50d5432d394ee79..0038da9cc364bad7a0959984521d5b78fcb446f0 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -404,8 +404,10 @@
       (unless (find col results :test #'string-equal)
         (push col results)))))
 
       (unless (find col results :test #'string-equal)
         (push col results)))))
 

-(defmethod database-list-attributes ((table string) (database mysql-database)
-                                     &key (owner nil))
+(defmethod database-list-attributes ((table clsql-sys::%database-identifier)
+                                     (database mysql-database)
+                                     &key (owner nil)
+                                     &aux (table (unescaped-database-identifier table)))

   (declare (ignore owner))
   (mapcar #'car
           (database-query
   (declare (ignore owner))
   (mapcar #'car
           (database-query


@@ -413,9 +415,12 @@
                                                 table database))
            database nil nil)))
 
                                                 table database))
            database nil nil)))
 

-(defmethod database-attribute-type (attribute (table string)
+(defmethod database-attribute-type ((attribute clsql-sys::%database-identifier)
+                                    (table clsql-sys::%database-identifier)

                                     (database mysql-database)
                                     (database mysql-database)

-                                    &key (owner nil))
+                                    &key (owner nil)
+                                    &aux (table (unescaped-database-identifier table))
+                                    (attribute (unescaped-database-identifier attribute)))

   (declare (ignore owner))
   (let ((row (car (database-query
                    (format nil
   (declare (ignore owner))
   (let ((row (car (database-query
                    (format nil

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index f01be3127739c4fb1adca4201fac1ab47f2f364f..af36bb91f02530d6fd66b63b644da3c8d94e22ef 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -1017,16 +1017,18 @@ as possible second argument) to the desired representation of date/time/timestam
   (with-error-handling (:hstmt hstmt)
     (SQLTables hstmt +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0)))
 
   (with-error-handling (:hstmt hstmt)
     (SQLTables hstmt +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0 +null-ptr+ 0)))
 

-(defun %table-statistics (table hstmt &key unique (ensure t))
+(defun %table-statistics (table hstmt &key unique (ensure t)
+                           &aux (table (princ-to-string
+                                        (clsql-sys::unescaped-database-identifier table))))

   (with-cstrings ((table-cs table))
   (with-cstrings ((table-cs table))

-    (with-error-handling (:hstmt hstmt)
-      (SQLStatistics
-       hstmt
-       +null-ptr+ 0
-       +null-ptr+ 0
-       table-cs $SQL_NTS
-       (if unique $SQL_INDEX_UNIQUE $SQL_INDEX_ALL)
-       (if ensure $SQL_ENSURE $SQL_QUICK)))))
+   (with-error-handling (:hstmt hstmt)
+       (SQLStatistics
+        hstmt
+        +null-ptr+ 0
+        +null-ptr+ 0
+        table-cs $SQL_NTS
+        (if unique $SQL_INDEX_UNIQUE $SQL_INDEX_ALL)
+        (if ensure $SQL_ENSURE $SQL_QUICK)))))

 
 (defun %list-data-sources (henv)
   (let ((results nil))
 
 (defun %list-data-sources (henv)
   (let ((results nil))

diff --git a/db-odbc/odbc-dbi.lisp b/db-odbc/odbc-dbi.lisp
index 319a8cc1ccea95dc97dfd0cc2974e29d69f4bee7..a3eb50b1817c699dd8343c53e22d205962646a45 100644 (file)
--- a/db-odbc/odbc-dbi.lisp
+++ b/db-odbc/odbc-dbi.lisp
@@ -207,22 +207,28 @@ the query against." ))
              (coerce (column-names query) 'list))))
       (db-close-query query))))
 
              (coerce (column-names query) 'list))))
       (db-close-query query))))
 

-(defun list-table-indexes (table &key db unique hstmt)
+(defun list-table-indexes (table &key db unique hstmt
+                            &aux (table
+                                     (princ-to-string
+                                      (clsql-sys::unescaped-database-identifier table))))

   (declare (ignore hstmt))
   (let ((query (get-free-query db)))
     (unwind-protect
   (declare (ignore hstmt))
   (let ((query (get-free-query db)))
     (unwind-protect

-        (progn
-          (with-slots (hstmt) query
-            (unless hstmt
-              (setf hstmt (%new-statement-handle (hdbc db))))
-            (%table-statistics table hstmt :unique unique)
-            (%initialize-query query nil nil)
-            (values
-             (db-fetch-query-results query)
-             (coerce (column-names query) 'list))))
+         (progn
+           (with-slots (hstmt) query
+             (unless hstmt
+               (setf hstmt (%new-statement-handle (hdbc db))))
+             (%table-statistics table hstmt :unique unique)
+             (%initialize-query query nil nil)
+             (values
+              (db-fetch-query-results query)
+              (coerce (column-names query) 'list))))

       (db-close-query query))))
 
       (db-close-query query))))
 

-(defun list-all-table-columns (table &key db hstmt)
+(defun list-all-table-columns (table &key db hstmt
+                                &aux (table
+                                         (princ-to-string
+                                          (clsql-sys::unescaped-database-identifier table))))

   (declare (ignore hstmt))
   (db-describe-columns db nil nil table nil))   ;; use nil rather than "" for unspecified values
 
   (declare (ignore hstmt))
   (db-describe-columns db nil nil table nil))   ;; use nil rather than "" for unspecified values
 

diff --git a/sql/fddl.lisp b/sql/fddl.lisp
index 267ee290f1dfe583650f68a39e2c73e4f4d55119..39a2a0c44f4a038db77409a07adb1eeaed7c7fd0 100644 (file)
--- a/sql/fddl.lisp
+++ b/sql/fddl.lisp
@@ -309,8 +309,10 @@ nil by default which means that only attributes owned by users
 are listed. If OWNER is a string denoting a user name, only
 attributes owned by OWNER are listed. If OWNER is :all then all
 attributes are listed."
 are listed. If OWNER is a string denoting a user name, only
 attributes owned by OWNER are listed. If OWNER is :all then all
 attributes are listed."

-  (database-list-attributes (escaped-database-identifier name database) database
-                            :owner owner))
+  (database-list-attributes
+   (database-identifier name database)
+   database
+   :owner owner))

 
 (defun attribute-type (attribute table &key (owner nil)
                                  (database *default-database*))
 
 (defun attribute-type (attribute table &key (owner nil)
                                  (database *default-database*))


@@ -323,8 +325,8 @@ returned. If OWNER is a string denoting a user name, the
 attribute, if it exists, must be owned by OWNER else nil is
 returned, whereas if OWNER is :all then the attribute, if it
 exists, will be returned regardless of its owner."
 attribute, if it exists, must be owned by OWNER else nil is
 returned, whereas if OWNER is :all then the attribute, if it
 exists, will be returned regardless of its owner."

-  (database-attribute-type (escaped-database-identifier attribute database)
-                           (escaped-database-identifier table database)
+  (database-attribute-type (database-identifier attribute database)
+                           (database-identifier table database)

                            database
                            :owner owner))
 
                            database
                            :owner owner))
 


@@ -342,7 +344,7 @@ second element is its SQL type, the third is the type precision,
 the fourth is the scale of the attribute and the fifth is 1 if
 the attribute accepts null values and otherwise 0."
   (with-slots (attribute-cache) database
 the fourth is the scale of the attribute and the fifth is 1 if
 the attribute accepts null values and otherwise 0."
   (with-slots (attribute-cache) database

-    (let ((table-ident (escaped-database-identifier table database)))
+    (let ((table-ident (database-identifier table database)))

       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
         (if (and found (second val))
             (second val)
       (multiple-value-bind (val found) (gethash table-ident attribute-cache)
         (if (and found (second val))
             (second val)


@@ -350,7 +352,7 @@ the attribute accepts null values and otherwise 0."
                                      (cons attribute
                                            (multiple-value-list
                                             (database-attribute-type
                                      (cons attribute
                                            (multiple-value-list
                                             (database-attribute-type

-                                             (escaped-database-identifier attribute
+                                             (database-identifier attribute

                                                                   database)
                                              table-ident
                                              database
                                                                   database)
                                              table-ident
                                              database

diff --git a/sql/generic-odbc.lisp b/sql/generic-odbc.lisp
index bd4d01cda033156bd6c0ff4aa0e6346cfca2a819..4995c25ff420a51112e5c553fcc6cec3e43f1545 100644 (file)
--- a/sql/generic-odbc.lisp
+++ b/sql/generic-odbc.lisp
@@ -250,8 +250,9 @@ on schema since that's what tends to be exposed. Some DBs like mssql
   (%database-list-* database "VIEW" owner))
 
 
   (%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
   (declare (ignore owner))
   (multiple-value-bind (rows col-names)
       (funcall (list-all-table-columns-fn database) table


@@ -261,8 +262,11 @@ on schema since that's what tends to be exposed. Some DBs like mssql
     (loop for row in rows
         collect (fourth row))))
 
     (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
   (declare (ignore owner))
   (multiple-value-bind (rows col-names)
       (funcall (list-all-table-columns-fn database) table

diff --git a/sql/generic-postgresql.lisp b/sql/generic-postgresql.lisp
index ecf6ddfde7ca2f404147c08aca113c95ec8e5e9a..4c726da68d5be6b83fff7decd8e9feeec6aa1004 100644 (file)
--- a/sql/generic-postgresql.lisp
+++ b/sql/generic-postgresql.lisp
@@ -140,10 +140,11 @@
               database nil nil))
        result))))
 
               database nil nil))
        result))))
 

-(defmethod database-list-attributes ((table string)
+(defmethod database-list-attributes ((table %database-identifier)

                                      (database generic-postgresql-database)
                                      &key (owner nil))
                                      (database generic-postgresql-database)
                                      &key (owner nil))

-  (let* ((owner-clause
+  (let* ((table (unescaped-database-identifier table))
+         (owner-clause

           (cond ((stringp owner)
                  (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
                 ((null owner) " AND (not (relowner=1))")
           (cond ((stringp owner)
                  (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
                 ((null owner) " AND (not (relowner=1))")


@@ -166,9 +167,12 @@
                                                "tableoid") :test #'equal))
                    result))))
 
                                                "tableoid") :test #'equal))
                    result))))
 

-(defmethod database-attribute-type (attribute (table string)
+(defmethod database-attribute-type ((attribute %database-identifier)
+                                    (table %database-identifier)

                                     (database generic-postgresql-database)
                                     (database generic-postgresql-database)

-                                    &key (owner nil))
+                                    &key (owner nil)
+                                    &aux (table (unescaped-database-identifier table))
+                                    (attribute (unescaped-database-identifier attribute)))

   (let ((row (car (database-query
                    (format nil "SELECT pg_type.typname,pg_attribute.attlen,pg_attribute.atttypmod,pg_attribute.attnotnull FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid~A"
                            (string-downcase table)
   (let ((row (car (database-query
                    (format nil "SELECT pg_type.typname,pg_attribute.attlen,pg_attribute.atttypmod,pg_attribute.attnotnull FROM pg_type,pg_class,pg_attribute WHERE pg_class.oid=pg_attribute.attrelid AND pg_class.relname='~A' AND pg_attribute.attname='~A' AND pg_attribute.atttypid=pg_type.oid~A"
                            (string-downcase table)

diff --git a/sql/utils.lisp b/sql/utils.lisp
index d5b31ed4fd1678862294132dfd7bee98e95c6ee8..52ee019943c3250946d6d465bbb3ca94210aaf43 100644 (file)
--- a/sql/utils.lisp
+++ b/sql/utils.lisp
@@ -16,6 +16,12 @@
 
 (in-package #:clsql-sys)
 
 
 (in-package #:clsql-sys)
 

+(defun %get-int (v)
+  (etypecase v
+    (string (parse-integer v :junk-allowed t))
+    (integer v)
+    (number (truncate v))))
+

 (defvar +whitespace-chars+
   '(#\space #\tab #\newline #\return
     ;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space
 (defvar +whitespace-chars+
   '(#\space #\tab #\newline #\return
     ;; Tested: sbcl unicode, allegrocl, openmcl,clisp use #\no-break_space