1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: postgresql-socket-sql.sql
6 ;;;; Purpose: High-level PostgreSQL interface using socket
7 ;;;; Authors: Kevin M. Rosenberg based on original code by Pierre R. Mai
12 ;;;; This file, part of CLSQL, is Copyright (c) 2002-2007 by Kevin M. Rosenberg
13 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
15 ;;;; CLSQL users are granted the rights to distribute and use this software
16 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
17 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
18 ;;;; *************************************************************************
20 (in-package #:cl-user)
22 (defpackage :clsql-postgresql-socket3
23 (:use #:common-lisp #:clsql-sys #:postgresql-socket3)
24 (:export #:postgresql-socket3-database)
25 (:documentation "This is the CLSQL socket interface to PostgreSQL."))
27 (in-package #:clsql-postgresql-socket3)
29 ;; interface foreign library loading routines
31 (clsql-sys:database-type-load-foreign :postgresql-socket3)
34 (defmethod database-initialize-database-type ((database-type
35 (eql :postgresql-socket3)))
39 ;; Field type conversion
40 (defun convert-to-clsql-warning (database condition)
41 (ecase *backend-warning-behavior*
43 (warn 'sql-database-warning :database database
44 :message (postgresql-condition-message condition)))
46 (error 'sql-database-error :database database
47 :message (format nil "Warning upgraded to error: ~A"
48 (postgresql-condition-message condition))))
53 (defun convert-to-clsql-error (database expression condition)
54 (error 'sql-database-data-error
56 :expression expression
57 :error-id (type-of condition)
58 :message (postgresql-condition-message condition)))
60 (defmacro with-postgresql-handlers
61 ((database &optional expression)
63 (let ((database-var (gensym))
64 (expression-var (gensym)))
65 `(let ((,database-var ,database)
66 (,expression-var ,expression))
67 (handler-bind ((postgresql-warning
69 (convert-to-clsql-warning ,database-var c)))
72 (convert-to-clsql-error
73 ,database-var ,expression-var c))))
78 (defclass postgresql-socket3-database (generic-postgresql-database)
79 ((connection :accessor database-connection :initarg :connection
80 :type cl-postgres:database-connection)))
82 (defmethod database-type ((database postgresql-socket3-database))
85 (defmethod database-name-from-spec (connection-spec (database-type (eql :postgresql-socket3)))
86 (check-connection-spec connection-spec database-type
87 (host db user password &optional port options tty))
88 (destructuring-bind (host db user password &optional port options tty)
90 (declare (ignore password options tty))
95 (pathname (namestring host))
101 (integer (write-to-string port))
105 (defmethod database-connect (connection-spec
106 (database-type (eql :postgresql-socket)))
107 (check-connection-spec connection-spec database-type
108 (host db user password &optional port options tty))
109 (destructuring-bind (host db user password &optional
110 (port +postgresql-server-default-port+)
111 (options "") (tty ""))
114 (handler-bind ((warning
119 (list (princ-to-string c))))))
120 (cl-postgres:open-database
127 (cl-postgres:database-error (c)
129 (error 'sql-connection-error
130 :database-type database-type
131 :connection-spec connection-spec
132 :error-id (type-of c)
133 :message (postgresql-condition-message c)))
134 (:no-error (connection)
135 ;; Success, make instance
136 (make-instance 'postgresql-socket3-database
137 :name (database-name-from-spec connection-spec database-type)
138 :database-type :postgresql-socket3
139 :connection-spec connection-spec
140 :connection connection)))))
142 (defmethod database-disconnect ((database postgresql-socket3-database))
143 (cl-postgres:close-database (database-connection database))
146 (defvar *include-field-names* nil)
148 (cl-postgres:def-row-reader clsql-default-row-reader (fields)
149 (values (loop :while (next-row)
150 :collect (loop :for field :across fields
151 :collect (next-field field)))
152 (when *include-field-names*
153 (loop :for field :across fields
154 :collect (field-name field)))))
156 (defmethod database-query ((expression string) (database postgresql-socket3-database) result-types field-names)
157 (let ((connection (database-connection database)))
158 (with-postgresql-handlers (database expression)
159 (let ((*include-field-names* field-names))
160 (cl-postgres:exec-query connection expression #'clsql-default-row-reader))
163 (defmethod database-execute-command
164 ((expression string) (database postgresql-socket3-database))
165 (let ((connection (database-connection database)))
166 (with-postgresql-handlers (database expression)
167 (exec-query connection expression))))
169 ;;;; Cursoring interface
172 ((next-row :accessor next-row :initarg :next-row :initform nil)
173 (fields :accessor fields :initarg :fields :initform nil)
174 (next-field :accessor next-field :initarg :next-field :initform nil)
175 (done :accessor done :initarg :done :initform nil)))
179 (cl-postgres:def-row-reader clsql-cursored-row-reader (fields)
181 (make-instance 'cursor :next-row #'next-row :fields fields :next-field #'next-field)))
183 (defmethod database-query-result-set ((expression string)
184 (database postgresql-socket3-database)
185 &key full-set result-types)
186 (declare (ignore full-set))
187 (let ((connection (database-connection database))
189 (with-postgresql-handlers (database expression)
190 (cl-postgres:exec-query connection expression 'clsql-cursored-row-reader)
191 (values *cursor* (length (fields *cursor*))))))
193 (defmethod database-dump-result-set (result-set
194 (database postgresql-socket3-database))
195 (unless (done result-set)
196 (loop :while (funcall (next-row result-set))))
199 (defmethod database-store-next-row (result-set
200 (database postgresql-socket3-database)
202 (when (and (not (done result-set))
203 (setf (done result-set) (funcall (next-row result-set))))
205 (let* ((data (loop :for field :across (fields result-set)
206 :collect (funcall (next-field result-set) field))))
208 (setf (car list) (car data)
209 (cdr list) (cdr data)))))
212 ;;;;;;;;;;;;;;;;;;;;;;;;;;
215 (defmethod database-create (connection-spec (type (eql :postgresql-socket3)))
216 (destructuring-bind (host name user password &optional port options tty) connection-spec
217 (let ((database (database-connect (list host "postgres" user password)
219 (setf (slot-value database 'clsql-sys::state) :open)
221 (database-execute-command (format nil "create database ~A" name) database)
222 (database-disconnect database)))))
224 (defmethod database-destroy (connection-spec (type (eql :postgresql-socket3)))
225 (destructuring-bind (host name user password &optional port optional tty) connection-spec
226 (let ((database (database-connect (list host "postgres" user password)
228 (setf (slot-value database 'clsql-sys::state) :open)
230 (database-execute-command (format nil "drop database ~A" name) database)
231 (database-disconnect database)))))
234 (defmethod database-probe (connection-spec (type (eql :postgresql-socket3)))
235 (when (find (second connection-spec) (database-list connection-spec type)
236 :test #'string-equal)
240 ;; Database capabilities
242 (defmethod db-backend-has-create/destroy-db? ((db-type (eql :postgresql-socket3)))
245 (defmethod db-type-has-fancy-math? ((db-type (eql :postgresql-socket3)))
248 (defmethod db-type-default-case ((db-type (eql :postgresql-socket3)))
251 (defmethod database-underlying-type ((database postgresql-socket3-database))
254 (when (clsql-sys:database-type-library-loaded :postgresql-socket3)
255 (clsql-sys:initialize-database-type :database-type :postgresql-socket3))