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

diff --git a/db-postgresql/postgresql-usql.lisp b/db-postgresql/postgresql-usql.lisp
index bdf6938..ef85e7d 100644
--- a/db-postgresql/postgresql-usql.lisp
+++ b/db-postgresql/postgresql-usql.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmers:   Kevin M. Rosenberg and onShore Development Inc
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: postgresql-usql.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
+;;;; $Id$
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and by onShore Development Inc.
@@ -17,30 +17,52 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(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)))
-
+(in-package #:clsql-postgresql)
 
 
+(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"
@@ -54,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