;;;; Purpose: High-level PostgreSQL interface using UFFI
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id$
-;;;;
;;;; CLSQL users are granted the rights to distribute and use this software
;;;; as governed by the terms of the Lisp Lesser GNU Public License
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
(t
nil)))))
-(defun tidy-error-message (message)
+(defun tidy-error-message (message &optional encoding)
(unless (stringp message)
- (setq message (uffi:convert-from-foreign-string message)))
+ (setq message (uffi:convert-from-foreign-string message :encoding encoding)))
(let ((message (string-right-trim '(#\Return #\Newline) message)))
(cond
((< (length message) (length "ERROR:"))
(error 'sql-database-data-error
:database database
:expression query-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr) (encoding database))))
(unwind-protect
(case (PQresultStatus result)
;; User gave a command rather than a query
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- result-types i)
+ (nth i result-types)
+ :encoding (encoding database))
nil)))))
(if field-names
(values res (result-field-names num-fields result))
(error 'sql-database-data-error
:database database
:expression query-expression
- :error-id (PQresultStatus result)
+ :error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))))
+ (PQresultErrorMessage result)
+ (encoding database)))))
(PQclear result))))))
(defun result-field-names (num-fields result)
(error 'sql-database-data-error
:database database
:expression sql-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr)
+ (encoding database))))
(unwind-protect
(case (PQresultStatus result)
(#.pgsql-exec-status-type#command-ok
:expression sql-expression
:error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))))
+ (PQresultErrorMessage result)
+ (encoding database)))))
(PQclear result))))))
(defstruct postgresql-result-set
(error 'sql-database-data-error
:database database
:expression query-expression
- :message (tidy-error-message (PQerrorMessage conn-ptr))))
+ :message (tidy-error-message (PQerrorMessage conn-ptr)
+ (encoding database))))
(case (PQresultStatus result)
((#.pgsql-exec-status-type#empty-query
#.pgsql-exec-status-type#tuples-ok)
(error 'sql-database-data-error
:database database
:expression query-expression
- :error-id (PQresultStatus result)
+ :error-id (PQresultErrorField result +PG-DIAG-SQLSTATE+)
:message (tidy-error-message
- (PQresultErrorMessage result)))
+ (PQresultErrorMessage result)
+ (encoding database)))
(PQclear result))))))))
(defmethod database-dump-result-set (result-set (database postgresql-database))
(if (zerop (PQgetisnull result tuple-index i))
(convert-raw-field
(PQgetvalue result tuple-index i)
- types i)
+ (nth i types)
+ :encoding (encoding database))
nil))
finally
(incf (postgresql-result-set-tuple-index result-set))
length :unsigned t))
(when (= (lo-read ptr fd buffer length) length)
(setf result (uffi:convert-from-foreign-string
- buffer :length length :null-terminated-p nil))))))
+ buffer :length length :null-terminated-p nil
+ :encoding (encoding database)))))))
(progn
(when buffer (uffi:free-foreign-object buffer))
(when (and fd (>= fd 0)) (lo-close ptr fd))
(defmethod database-create (connection-spec (type (eql :postgresql)))
(destructuring-bind (host name user password) connection-spec
- (declare (ignore user password))
- (multiple-value-bind (output status)
- (clsql-sys:command-output "createdb -h~A ~A"
- (if host host "localhost")
- name)
- (if (or (not (zerop status))
- (search "database creation failed: ERROR:" output))
- (error 'sql-database-error
- :message
- (format nil "createdb failed for postgresql backend with connection spec ~A."
- connection-spec))
- t))))
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "create database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-destroy (connection-spec (type (eql :postgresql)))
(destructuring-bind (host name user password) connection-spec
- (declare (ignore user password))
- (multiple-value-bind (output status)
- (clsql-sys:command-output "dropdb -h~A ~A"
- (if host host "localhost")
- name)
- (if (or (not (zerop status))
- (search "database removal failed: ERROR:" output))
- (error 'sql-database-error
- :message
- (format nil "dropdb failed for postgresql backend with connection spec ~A."
- connection-spec))
- t))))
+ (let ((database (database-connect (list host "postgres" user password)
+ type)))
+ (setf (slot-value database 'clsql-sys::state) :open)
+ (unwind-protect
+ (database-execute-command (format nil "drop database ~A" name) database)
+ (database-disconnect database)))))
(defmethod database-probe (connection-spec (type (eql :postgresql)))