r9113: intial changes for list-table-indexes

[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 9a2f02d04b60d843defdbae8ba9b298c8bc3c8e7..6307f05f662c7275ad363d5f170d8cea09b35edb 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -194,6 +194,7 @@ doesn't depend on UFFI."
                 (make-instance 'postgresql-socket-database
                                :name (database-name-from-spec connection-spec
                                                               database-type)
+                               :database-type :postgresql-socket
                                :connection-spec connection-spec
                                :connection connection)))))
 
@@ -313,22 +314,27 @@ doesn't depend on UFFI."
 
 ;;; Object listing
 
+(defun owner-clause (owner)
+  (cond 
+   ((stringp owner)
+    (format
+     nil
+     " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" 
+     owner))
+   ((null owner)
+    (format nil " AND (NOT (relowner=1))"))
+   (t "")))
+
 (defmethod database-list-objects-of-type ((database postgresql-socket-database)
                                           type owner)
-  (let ((owner-clause
-         (cond ((stringp owner)
-                (format nil " AND (relowner=(SELECT usesysid FROM pg_user WHERE (usename='~A')))" owner))
-               ((null owner)
-                (format nil " AND (NOT (relowner=1))"))
-               (t ""))))
-    (mapcar #'car
-            (database-query
-             (format nil
-                     "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
-                     type
-                     owner-clause)
-             database nil))))
-    
+  (mapcar #'car
+         (database-query
+          (format nil
+                  "SELECT relname FROM pg_class WHERE (relkind = '~A')~A"
+                  type
+                  (owner-clause owner))
+          database nil)))
+
 (defmethod database-list-tables ((database postgresql-socket-database)
                                  &key (owner nil))
   (database-list-objects-of-type database "r" owner))
@@ -340,7 +346,28 @@ doesn't depend on UFFI."
 (defmethod database-list-indexes ((database postgresql-socket-database)
                                   &key (owner nil))
   (database-list-objects-of-type database "i" owner))
-  
+
+(defmethod database-list-table-indexes (table
+                                       (database postgresql-socket-database)
+                                       &key (owner nil))
+  (let ((indexrelids
+        (database-query
+         (format 
+          nil
+          "select indexrelid from pg_index where indrelid=(select relfilenode from pg_class where relname='~A'~A)"
+          (string-downcase table)
+          (owner-clause owner))
+         database :auto))
+       (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))
+       result))))
+
 (defmethod database-list-attributes ((table string)
                                     (database postgresql-socket-database)
                                      &key (owner nil))
@@ -430,28 +457,52 @@ doesn't depend on UFFI."
   
 
 (defmethod database-create (connection-spec (type (eql :postgresql-socket)))
-  (error 'clsql-access-error
-        :connection-spec connection-spec
-        :database-type type
-        :error "Unable to create databases on a socket connection."))
+  (destructuring-bind (host name user password) connection-spec
+    (let ((database (database-connect (list host "template1" user password)
+                                     type)))
+      (unwind-protect
+          (execute-command (format nil "create database ~A" name))
+       (database-disconnect database)))))
 
 (defmethod database-destroy (connection-spec (type (eql :postgresql-socket)))
-  (error 'clsql-access-error
-        :connection-spec connection-spec
-        :database-type type
-        :error "Unable to create databases on a socket connection."))
+  (destructuring-bind (host name user password) connection-spec
+    (let ((database (database-connect (list host "template1" user password)
+                                     type)))
+      (unwind-protect
+         (execute-command (format nil "drop database ~A" name))
+       (database-disconnect database)))))
+
 
 (defmethod database-probe (connection-spec (type (eql :postgresql-socket)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+             :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :postgresql-socket)))
   (destructuring-bind (host name user password) connection-spec
+    (declare (ignore name))
     (let ((database (database-connect (list host "template1" user password)
                                      type)))
       (unwind-protect
-         (when
-             (find name (database-query "select datname from pg_database" 
-                                        database :auto)
-                   :key #'car :test #'string-equal)
-           t)
-       (database-disconnect database)))))
+          (progn
+            (setf (slot-value database 'clsql-base-sys::state) :open)
+            (mapcar #'car (database-query "select datname from pg_database" 
+                                          database :auto)))
+       (progn
+         (database-disconnect database)
+         (setf (slot-value database 'clsql-base-sys::state) :closed))))))
+
+(defmethod database-describe-table ((database postgresql-socket-database) 
+                                   table)
+  (database-query
+   (format nil "select a.attname, t.typname
+                               from pg_class c, pg_attribute a, pg_type t
+                               where c.relname = '~a'
+                                   and a.attnum > 0
+                                   and a.attrelid = c.oid
+                                   and a.atttypid = t.oid"
+           (sql-escape (string-downcase table)))
+   database :auto))
 
 (when (clsql-base-sys:database-type-library-loaded :postgresql-socket)
   (clsql-base-sys:initialize-database-type :database-type :postgresql-socket))