X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-postgresql%2Fpostgresql-sql.lisp;h=3d1eca3a2b614c4ec2a4d4576d22b72536514899;hb=db9892632e6eb7869aea7a94c16b523a82de1501;hp=5758730e07f19486a79086b364456f3277a8a080;hpb=064bb338ef1375940085db10ec5a202d32e6b68b;p=clsql.git

diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp
index 5758730..3d1eca3 100644
--- a/db-postgresql/postgresql-sql.lisp
+++ b/db-postgresql/postgresql-sql.lisp
@@ -366,22 +366,27 @@
 
 ;;; 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-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-database)
                                  &key (owner nil))
   (database-list-objects-of-type database "r" owner))
@@ -393,7 +398,28 @@
 (defmethod database-list-indexes ((database postgresql-database)
                                   &key (owner nil))
   (database-list-objects-of-type database "i" owner))
-  
+
+
+(defmethod database-list-table-indexes (table (database postgresql-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-database)
                                      &key (owner nil))
@@ -517,16 +543,23 @@
 
 
 (defmethod database-probe (connection-spec (type (eql :postgresql)))
+  (when (find (second connection-spec) (database-list connection-spec type)
+	      :key #'car :test #'string-equal)
+    t))
+
+(defmethod database-list (connection-spec (type (eql :postgresql)))
   (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 nil)))
+	(progn
+	  (database-disconnect database)
+	  (setf (slot-value database 'clsql-base-sys::state) :closed))))))
 
 (defmethod database-describe-table ((database postgresql-database) table)
   (database-query 
@@ -536,12 +569,7 @@
                                    and a.attnum > 0
                                    and a.attrelid = c.oid
                                    and a.atttypid = t.oid"
-           (sql-escape (string-downcase 
-			(etypecase table
-			  (string table)
-			  (clsql-base-sys::sql-create-table
-			   (symbol-name 
-			    (slot-value table 'clsql-base-sys::name)))))))
+           (sql-escape (string-downcase table)))
    database :auto))
 
 (defun %pg-database-connection (connection-spec)