X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=interfaces%2Fpostgresql%2Fpostgresql-sql.cl;h=cb02f60bf3489d9781423e3f55a916ee7e419fd7;hb=ace1cb9084e3e8fd4773625fc413c039ebd3b1f4;hp=21cb247eed7b7defced65805d84835a814e59711;hpb=2073ba6b66571d3da57523dbdcb30ed6ffb4b161;p=clsql.git diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl index 21cb247..cb02f60 100644 --- a/interfaces/postgresql/postgresql-sql.cl +++ b/interfaces/postgresql/postgresql-sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: postgresql-sql.cl,v 1.13 2002/04/19 20:25:20 marc.battyani Exp $ +;;;; $Id: postgresql-sql.cl,v 1.18 2002/05/27 17:19:30 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -22,7 +22,7 @@ (in-package :cl-user) (defpackage :clsql-postgresql - (:use :common-lisp :clsql-sys :postgresql :clsql-uffi) + (:use :common-lisp :clsql-base-sys :postgresql :clsql-uffi) (:export #:postgresql-database) (:documentation "This is the CLSQL interface to PostgreSQL.")) @@ -87,6 +87,9 @@ ((conn-ptr :accessor database-conn-ptr :initarg :conn-ptr :type pgsql-conn-def))) +(defmethod database-type ((database postgresql-database)) + :postgresql) + (defmethod database-name-from-spec (connection-spec (database-type (eql :postgresql))) (check-connection-spec connection-spec database-type @@ -125,6 +128,7 @@ (make-instance 'postgresql-database :name (database-name-from-spec connection-spec database-type) + :connection-spec connection-spec :conn-ptr connection))))) @@ -281,19 +285,38 @@ (lo-create (database-conn-ptr database) (logior postgresql::+INV_WRITE+ postgresql::+INV_READ+))) -;; (MB)the begin/commit/rollback stuff will be removed when with-transaction wil be implemented -(defmethod database-write-large-object ( object-id (data string) (database postgresql-database)) + +#+mb-original +(defmethod database-write-large-object (object-id (data string) (database postgresql-database)) (let ((ptr (database-conn-ptr database)) (length (length data)) (result nil) (fd nil)) + (with-transaction (:database database) + (unwind-protect + (progn + (setf fd (lo-open ptr object-id postgresql::+INV_WRITE+)) + (when (>= fd 0) + (when (= (lo-write ptr fd data length) length) + (setf result t)))) + (progn + (when (and fd (>= fd 0)) + (lo-close ptr fd)) + ))) + result)) + +(defmethod database-write-large-object (object-id (data string) (database postgresql-database)) + (let ((ptr (database-conn-ptr database)) + (length (length data)) + (result nil) + (fd nil)) + (database-execute-command "begin" database) (unwind-protect - (progn - (database-execute-command "begin" database) - (setf fd (lo-open ptr object-id postgresql::+INV_WRITE+)) - (when (>= fd 0) - (when (= (lo-write ptr fd data length) length) - (setf result t)))) + (progn + (setf fd (lo-open ptr object-id postgresql::+INV_WRITE+)) + (when (>= fd 0) + (when (= (lo-write ptr fd data length) length) + (setf result t)))) (progn (when (and fd (>= fd 0)) (lo-close ptr fd)) @@ -301,6 +324,7 @@ result)) ;; (MB) the begin/commit/rollback stuff will be removed when with-transaction wil be implemented +;; (KMR) Can't use with-transaction since that function is in high-level code (defmethod database-read-large-object (object-id (database postgresql-database)) (let ((ptr (database-conn-ptr database)) (buffer nil) @@ -315,7 +339,8 @@ (setf length (lo-lseek ptr fd 0 2)) (lo-lseek ptr fd 0 0) (when (> length 0) - (setf buffer (uffi:allocate-foreign-string length :type '(:unsigned :byte))) + (setf buffer (uffi:allocate-foreign-string + 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)))))) @@ -327,3 +352,7 @@ (defmethod database-delete-large-object (object-id (database postgresql-database)) (lo-unlink (database-conn-ptr database) object-id)) + +(when (clsql-base-sys:database-type-library-loaded :postgresql) + (clsql-base-sys:initialize-database-type :database-type :postgresql) + (pushnew :postgresql cl:*features*))