r9185: first effort at support field names in QUERY calls, still needs testing

[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 50c6899afc0f8c6a4a36fefc0597fdb911967663..626e4f151e33156fc04e52421ff9f91069ede4db 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -2,15 +2,14 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:          postgresql-socket-sql.sql
-;;;; Purpose:       High-level PostgreSQL interface using socket
-;;;; Programmers:   Kevin M. Rosenberg based on
-;;;;                Original code by Pierre R. Mai 
-;;;; Date Started:  Feb 2002
+;;;; Name:     postgresql-socket-sql.sql
+;;;; Purpose:  High-level PostgreSQL interface using socket
+;;;; Authors:  Kevin M. Rosenberg based on original code by Pierre R. Mai 
+;;;; Created:  Feb 2002
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of CLSQL, is Copyright (c) 2002-2004 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
 ;;;;
 ;;;; CLSQL users are granted the rights to distribute and use this software
@@ -202,7 +201,7 @@ doesn't depend on UFFI."
   (close-postgresql-connection (database-connection database))
   t)
 
-(defmethod database-query (expression (database postgresql-socket-database) result-types)
+(defmethod database-query (expression (database postgresql-socket-database) result-types field-names)
   (let ((connection (database-connection database)))
     (with-postgresql-handlers (database expression)
       (start-query-execution connection expression)
@@ -216,17 +215,25 @@ doesn't depend on UFFI."
                 :errno 'missing-result
                 :error "Didn't receive result cursor for query."))
        (setq result-types (canonicalize-types result-types cursor))
-       (loop for row = (read-cursor-row cursor result-types)
-             while row
-             collect row
-             finally
-             (unless (null (wait-for-query-results connection))
-               (close-postgresql-connection connection)
-               (error 'clsql-sql-error
-                      :database database
-                      :expression expression
-                      :errno 'multiple-results
-                      :error "Received multiple results for query.")))))))
+        (values
+         (loop for row = (read-cursor-row cursor result-types)
+               while row
+               collect row
+               finally
+               (unless (null (wait-for-query-results connection))
+                 (close-postgresql-connection connection)
+                 (error 'clsql-sql-error
+                        :database database
+                        :expression expression
+                        :errno 'multiple-results
+                        :error "Received multiple results for query.")))
+         (when field-names
+           (result-field-names cursor)))))))
+
+(defun result-field-names (cursor)
+  "Return list of result field names."
+  ;; FIXME -- implement
+  nil)
 
 (defmethod database-execute-command
     (expression (database postgresql-socket-database))
@@ -314,22 +321,26 @@ doesn't depend on UFFI."
 
 ;;; Object listing
 
-(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))))
-    
+(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 "")))
+
+(defun database-list-objects-of-type (database type owner)
+  (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))
@@ -341,7 +352,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))
@@ -478,5 +510,17 @@ doesn't depend on UFFI."
            (sql-escape (string-downcase table)))
    database :auto))
 
+
+;; Database capabilities
+
+(defmethod db-backend-has-create/destroy-db? ((db-type (eql :postgresql-socket)))
+  nil)
+
+(defmethod db-type-has-fancy-math? ((db-type (eql :postgresql-socket)))
+  t)
+
+(defmethod db-type-default-case ((db-type (eql :postgresql)))
+  :lower)
+
 (when (clsql-base-sys:database-type-library-loaded :postgresql-socket)
   (clsql-base-sys:initialize-database-type :database-type :postgresql-socket))