r8811: add support for usql backend, integrate Marcus Pearce <ek735@soi.city.ac.uk...

[clsql.git] / db-postgresql / postgresql-usql.lisp

diff --git a/db-postgresql/postgresql-usql.lisp b/db-postgresql/postgresql-usql.lisp
index b42438b2259c556634246a4b6a32869dbe51cfbe..ef85e7dbc20586b49833b916bf6d1adfdef50e93 100644 (file)
--- 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