X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-postgresql%2Fpostgresql-usql.lisp;h=ef85e7dbc20586b49833b916bf6d1adfdef50e93;hp=b42438b2259c556634246a4b6a32869dbe51cfbe;hb=43ec897ec7d84892fa59cc9b7858ce23d64a8a1a;hpb=bada52b7a8fd2cc484dee33cccd64ca09a52ec3d

diff --git a/db-postgresql/postgresql-usql.lisp b/db-postgresql/postgresql-usql.lisp
index b42438b..ef85e7d 100644
--- a/db-postgresql/postgresql-usql.lisp
+++ b/db-postgresql/postgresql-usql.lisp
@@ -19,27 +19,50 @@
 
 (in-package #:clsql-postgresql)
 
-(defmethod database-list-tables ((database postgresql-database)
-                                 &key (system-tables nil))
-  (let ((res (mapcar #'car (database-query
-			    "SELECT tablename FROM pg_tables"
-			    database nil))))
-    (if (not system-tables)
-        (remove-if #'(lambda (table)
-                       (equal (subseq table 0 3)
-                              "pg_")) res)
-      res)))
-
-
 
+(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))))
+    
+(defmethod database-list-tables ((database postgresql-database)
+                                 &key (owner nil))
+  (database-list-objects-of-type database "r" owner))
+  
+(defmethod database-list-views ((database postgresql-database)
+                                &key (owner nil))
+  (database-list-objects-of-type database "v" owner))
+  
+(defmethod database-list-indexes ((database postgresql-database)
+                                  &key (owner nil))
+  (database-list-objects-of-type database "i" owner))
+  
 (defmethod database-list-attributes ((table string)
-				     (database postgresql-database))
-  (let* ((result
+				     (database postgresql-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 attname FROM pg_class,pg_attribute WHERE pg_class.oid=attrelid AND relname='~A'" table)
-		   database nil))))
+		   (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))))
     (if result
 	(reverse
          (remove-if #'(lambda (it) (member it '("cmin"
@@ -53,35 +76,65 @@
 		    result)))))
 
 (defmethod database-attribute-type (attribute (table string)
-				    (database postgresql-database))
-  (let ((result
+				    (database postgresql-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"
-			   table attribute)
+		   (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"
+			   (string-downcase table)
+                           (string-downcase attribute)
+                           owner-clause)
 		   database nil))))
-    (if result
-	(intern (string-upcase (car result)) :keyword) nil)))
-
+    (when result
+      (intern (string-upcase (car result)) :keyword))))
 
 (defmethod database-create-sequence (sequence-name
 				     (database postgresql-database))
   (database-execute-command
-   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name)) database))
+   (concatenate 'string "CREATE SEQUENCE " (sql-escape sequence-name))
+   database))
 
 (defmethod database-drop-sequence (sequence-name
 				   (database postgresql-database))
   (database-execute-command
    (concatenate 'string "DROP SEQUENCE " (sql-escape sequence-name)) database))
 
+(defmethod database-list-sequences ((database postgresql-database)
+                                    &key (owner nil))
+  (database-list-objects-of-type database "S" owner))
+
+(defmethod database-set-sequence-position (name (position integer)
+                                                (database postgresql-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (format nil "SELECT SETVAL ('~A', ~A)" name position)
+      database nil)))))
+
 (defmethod database-sequence-next (sequence-name 
 				   (database postgresql-database))
-  (parse-integer
-   (caar
-    (database-query
-     (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
-     database nil))))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT NEXTVAL ('" (sql-escape sequence-name) "')")
+      database nil)))))
+
+(defmethod database-sequence-last (sequence-name (database postgresql-database))
+  (values
+   (parse-integer
+    (caar
+     (database-query
+      (concatenate 'string "SELECT LAST_VALUE ('" sequence-name "')")
+      database nil)))))
+  
 
 ;; Functions depending upon high-level USQL classes/functions