r9186: add attribute caching, improve inititialize-database-type

[clsql.git] / db-postgresql-socket / postgresql-socket-sql.lisp

diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index 626e4f151e33156fc04e52421ff9f91069ede4db..07032b826fd7ede336395c338bff5f159f1b0662 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -228,12 +228,7 @@ doesn't depend on UFFI."
                         :errno 'multiple-results
                         :error "Received multiple results for query.")))
          (when field-names
-           (result-field-names cursor)))))))
-
-(defun result-field-names (cursor)
-  "Return list of result field names."
-  ;; FIXME -- implement
-  nil)
+          (mapcar #'car (postgresql-cursor-fields cursor))))))))
 
 (defmethod database-execute-command
     (expression (database postgresql-socket-database))
@@ -339,7 +334,7 @@ doesn't depend on UFFI."
                   "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
                   type
                   (owner-clause owner))
-          database nil)))
+          database nil nil)))
 
 (defmethod database-list-tables ((database postgresql-socket-database)
                                  &key (owner nil))
@@ -363,15 +358,14 @@ doesn't depend on UFFI."
           "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where relname='~A'~A)"
           (string-downcase table)
           (owner-clause owner))
-         database :auto))
+         database :auto nil))
        (result nil))
     (dolist (indexrelid indexrelids (nreverse result))
       (push 
        (caar (database-query
              (format nil "select relname from pg_class where relfilenode='~A'"
                      (car indexrelid))
-             database
-             nil))
+             database nil nil))
        result))))
 
 (defmethod database-list-attributes ((table string)
@@ -388,7 +382,7 @@ doesn't depend on UFFI."
                   (format nil "SELECT attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'~A"
                            (string-downcase table)
                            owner-clause)
-                   database nil))))
+                   database nil nil))))
     (if result
        (reverse
          (remove-if #'(lambda (it) (member it '("cmin"
@@ -404,21 +398,22 @@ doesn't depend on UFFI."
 (defmethod database-attribute-type (attribute (table string)
                                    (database postgresql-socket-database)
                                     &key (owner nil))
-  (let* ((owner-clause
-          (cond ((stringp owner)
-                 (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE usename='~A'))" owner))
-                ((null owner) " AND (not (relowner=1))")
-                (t "")))
-         (result
-         (mapcar #'car
-                 (database-query
-                  (format nil "SELECT pg_type.typname 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"
+  (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)
-                           (string-downcase attribute)
-                           owner-clause)
-                  database nil))))
-    (when result
-      (intern (string-upcase (car result)) :keyword))))
+                          (string-downcase attribute)
+                          (owner-clause owner))
+                  database nil nil))))
+    (when row
+      (values
+       (ensure-keyword (first row))
+       (if (string= "-1" (second row))
+          (- (parse-integer (third row) :junk-allowed t) 4)
+        (parse-integer (second row)))
+       nil
+       (if (string-equal "f" (fourth row))
+          1
+        0)))))
 
 (defmethod database-create-sequence (sequence-name
                                     (database postgresql-socket-database))
@@ -442,7 +437,7 @@ doesn't depend on UFFI."
     (caar
      (database-query
       (format nil "SELECT SETVAL ('~A', ~A)" name position)
-      database nil)))))
+      database nil nil)))))
 
 (defmethod database-sequence-next (sequence-name 
                                   (database postgresql-socket-database))
@@ -451,7 +446,7 @@ doesn't depend on UFFI."
     (caar
      (database-query
       (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
-      database nil)))))
+      database nil nil)))))
 
 (defmethod database-sequence-last (sequence-name (database postgresql-socket-database))
   (values
@@ -459,7 +454,7 @@ doesn't depend on UFFI."
     (caar
      (database-query
       (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')")
-      database nil)))))
+      database nil nil)))))
   
 
 (defmethod database-create (connection-spec (type (eql :postgresql-socket)))
@@ -493,7 +488,7 @@ doesn't depend on UFFI."
           (progn
             (setf (slot-value database 'clsql-base-sys::state) :open)
             (mapcar #'car (database-query "select datname from pg_database" 
-                                          database :auto)))
+                                          database :auto nil)))
        (progn
          (database-disconnect database)
          (setf (slot-value database 'clsql-base-sys::state) :closed))))))
@@ -508,7 +503,7 @@ doesn't depend on UFFI."
                                    and a.attrelid = c.oid
                                    and a.atttypid = t.oid"
            (sql-escape (string-downcase table)))
-   database :auto))
+   database :auto nil))
 
 
 ;; Database capabilities
@@ -519,7 +514,7 @@ doesn't depend on UFFI."
 (defmethod db-type-has-fancy-math? ((db-type (eql :postgresql-socket)))
   t)
 
-(defmethod db-type-default-case ((db-type (eql :postgresql)))
+(defmethod db-type-default-case ((db-type (eql :postgresql-socket)))
   :lower)
 
 (when (clsql-base-sys:database-type-library-loaded :postgresql-socket)