From: Marc Battyani <marc.battyani@fractalconcept.com>
Date: Fri, 19 Apr 2002 20:25:20 +0000 (+0000)
Subject: r1781: Large objects support for Postgresql
X-Git-Tag: v3.8.6~1149
X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=2073ba6b66571d3da57523dbdcb30ed6ffb4b161

r1781: Large objects support for Postgresql
---

diff --git a/interfaces/postgresql/postgresql-api.cl b/interfaces/postgresql/postgresql-api.cl
index 83ba307..5f67961 100644
--- a/interfaces/postgresql/postgresql-api.cl
+++ b/interfaces/postgresql/postgresql-api.cl
@@ -8,7 +8,7 @@
 ;;;;                Original code by Pierre R. Mai 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-api.cl,v 1.5 2002/03/29 09:37:24 kevin Exp $
+;;;; $Id: postgresql-api.cl,v 1.6 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -202,3 +202,66 @@
   ((conn pgsql-conn))
   :module "postgresql"
   :returning :int)
+
+
+;;; Large objects support (MB)
+
+(defconstant +INV_ARCHIVE+ 65536)         ; fe-lobj.c
+(defconstant +INV_WRITE+   131072)
+(defconstant +INV_READ+    262144)
+
+(declaim (inline lo-creat))
+(uffi:def-function ("lo_creat" lo-create)
+  ((conn pgsql-conn)
+   (mode :int))
+  :module "postgresql"
+  :returning pgsql-oid)
+
+(declaim (inline lo-open))
+(uffi:def-function ("lo_open" lo-open)
+  ((conn pgsql-conn)
+   (oid pgsql-oid)
+   (mode :int))
+  :module "postgresql"
+  :returning :int)
+
+(declaim (inline lo-write))
+(uffi:def-function ("lo_write" lo-write)
+  ((conn pgsql-conn)
+   (fd :int)
+   (data :cstring)
+   (size :int))
+  :module "postgresql"
+  :returning :int)
+
+(declaim (inline lo-read))
+(uffi:def-function ("lo_read" lo-read)
+  ((conn pgsql-conn)
+   (fd :int)
+   (data (* :unsigned-char))
+   (size :int))
+  :module "postgresql"
+  :returning :int)
+
+(declaim (inline lo-lseek))
+(uffi:def-function ("lo_lseek" lo-lseek)
+  ((conn pgsql-conn)
+   (fd :int)
+   (offset :int)
+   (whence :int))
+  :module "postgresql"
+  :returning :int)
+
+(declaim (inline lo-close))
+(uffi:def-function ("lo_close" lo-close)
+  ((conn pgsql-conn)
+   (fd :int))
+  :module "postgresql"
+  :returning :int)
+
+(declaim (inline lo-unlink))
+(uffi:def-function ("lo_unlink" lo-unlink)
+  ((conn pgsql-conn)
+   (oid pgsql-oid))
+  :module "postgresql"
+  :returning :int)
diff --git a/interfaces/postgresql/postgresql-package.cl b/interfaces/postgresql/postgresql-package.cl
index 96f0bfb..22c4a3f 100644
--- a/interfaces/postgresql/postgresql-package.cl
+++ b/interfaces/postgresql/postgresql-package.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: postgresql-package.cl,v 1.6 2002/03/29 09:37:24 kevin Exp $
+;;;; $Id: postgresql-package.cl,v 1.7 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -69,6 +69,15 @@
      #:PQgetisnull
      #:PQclear
      #:PQisBusy
+     
+     ;;Large Objects (Marc B)
+     #:lo-create
+     #:lo-open
+     #:lo-write
+     #:lo-read
+     #:lo-lseek
+     #:lo-close
+     #:lo-unlink
      )
     (:documentation "This is the low-level interface to PostgreSQL."))
 
diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl
index 275ac39..21cb247 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.12 2002/03/29 09:37:24 kevin Exp $
+;;;; $Id: postgresql-sql.cl,v 1.13 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -274,3 +274,56 @@
           finally
             (incf (postgresql-result-set-tuple-index result-set))
             (return list)))))
+
+;;; Large objects support (Marc B)
+
+(defmethod database-create-large-object ((database postgresql-database))
+  (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))
+  (let ((ptr (database-conn-ptr database))
+	(length (length data))
+	(result nil)
+	(fd nil))
+    (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
+	(when (and fd (>= fd 0))
+	  (lo-close ptr fd))
+	(database-execute-command (if result "commit" "rollback") database)))
+    result))
+
+;; (MB) the begin/commit/rollback stuff will be removed when with-transaction wil be implemented
+(defmethod database-read-large-object (object-id (database postgresql-database))
+  (let ((ptr (database-conn-ptr database))
+	(buffer nil)
+	(result nil)
+	(length 0)
+	(fd nil))
+    (unwind-protect
+       (progn
+	 (database-execute-command "begin" database)
+	 (setf fd (lo-open ptr object-id postgresql::+INV_READ+))
+	 (when (>= fd 0)
+	   (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)))
+	     (when (= (lo-read ptr fd buffer length) length)
+	       (setf result (uffi:convert-from-foreign-string
+			     buffer :length length :null-terminated-p nil))))))
+      (progn
+	(when buffer (uffi:free-foreign-object buffer))
+	(when (and fd (>= fd 0)) (lo-close ptr fd))
+	(database-execute-command (if result "commit" "rollback") database)))
+    result))
+
+(defmethod database-delete-large-object (object-id (database postgresql-database))
+  (lo-unlink (database-conn-ptr database) object-id))
diff --git a/sql/db-interface.cl b/sql/db-interface.cl
index 0fac5b2..1ce8681 100644
--- a/sql/db-interface.cl
+++ b/sql/db-interface.cl
@@ -9,7 +9,7 @@
 ;;;;                onShoreD to support UncommonSQL front-end 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: db-interface.cl,v 1.5 2002/04/01 05:27:55 kevin Exp $
+;;;; $Id: db-interface.cl,v 1.6 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai, and onShoreD
@@ -159,3 +159,16 @@ the given lisp type and parameters."))
   (:documentation "Return the unique ID of a database object."))
 
  
+;;; Large objects support (Marc Battyani)
+
+(defgeneric database-create-large-object (database)
+  (:documentation "Creates a new large object in the database and returns the object identifier"))
+
+(defgeneric database-write-large-object (object-id (data string) database)
+  (:documentation "Writes data to the large object"))
+
+(defgeneric database-read-large-object (object-id database)
+  (:documentation "Reads the large object content"))
+
+(defgeneric database-delete-large-object (object-id database)
+  (:documentation "Deletes the large object in the database"))
diff --git a/sql/package.cl b/sql/package.cl
index f816764..2db3c44 100644
--- a/sql/package.cl
+++ b/sql/package.cl
@@ -8,7 +8,7 @@
 ;;;;                Original code by Pierre R. Mai 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: package.cl,v 1.6 2002/04/07 15:23:10 kevin Exp $
+;;;; $Id: package.cl,v 1.7 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -51,6 +51,13 @@
      #:database-sequence-next
     
      #:sql-escape
+     
+     ;; Large objects (Marc B)
+     #:database-create-large-object
+     #:database-write-large-object
+     #:database-read-large-object
+     #:database-delete-large-object
+     
      ;; Shared exports for re-export by CLSQL
      .
      #1=(#:clsql-condition
@@ -123,6 +130,11 @@
 	 #:drop-sequence
 	 #:sequence-next
 	 
+	 ;; Large objects (Marc B)
+	 #:create-large-object
+	 #:write-large-object
+	 #:read-large-object
+	 #:delete-large-object
 	 ))
     (:documentation "This is the INTERNAL SQL-Interface package of CLSQL."))
 
diff --git a/sql/sql.cl b/sql/sql.cl
index f0d5bee..4b88fd5 100644
--- a/sql/sql.cl
+++ b/sql/sql.cl
@@ -8,7 +8,7 @@
 ;;;;                 Original code by Pierre R. Mai 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: sql.cl,v 1.11 2002/03/29 08:34:44 kevin Exp $
+;;;; $Id: sql.cl,v 1.12 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -270,5 +270,20 @@ specified in output-type-spec and returned like in MAP."
 		    ,@body))
 	     (database-dump-result-set ,result-set ,db)))))))
 
+;;; Marc Battyani : Large objects support
 
+(defun create-large-object (&key (database *default-database*))
+  "Creates a new large object in the database and returns the object identifier"
+  (database-create-large-object database))
 
+(defun write-large-object (object-id data &key (database *default-database*))
+  "Writes data to the large object"
+  (database-write-large-object object-id data database))
+
+(defun read-large-object (object-id &key (database *default-database*))
+  "Reads the large object content"
+  (database-read-large-object object-id database))
+
+(defun delete-large-object (object-id &key (database *default-database*))
+  "Deletes the large object in the database"
+  (database-delete-large-object object-id database))
diff --git a/test-suite/acl-compat-tester.cl b/test-suite/acl-compat-tester.cl
index 1ce4fef..08c5160 100644
--- a/test-suite/acl-compat-tester.cl
+++ b/test-suite/acl-compat-tester.cl
@@ -24,7 +24,7 @@
 ;; Place, Suite 330, Boston, MA  02111-1307  USA
 ;;
 ;;;; from the original ACL 6.1 sources:
-;; $Id: acl-compat-tester.cl,v 1.1 2002/04/08 02:46:43 kevin Exp $
+;; $Id: acl-compat-tester.cl,v 1.2 2002/04/19 20:25:20 marc.battyani Exp $
 
 
 (defpackage :util.test
@@ -50,6 +50,7 @@
 
 (in-package :util.test)
 
+#-lispworks
 (unless (find-class 'break nil)
   (define-condition break (simple-condition) ()))
 
diff --git a/test-suite/tester-clsql.cl b/test-suite/tester-clsql.cl
index f3e6bef..03045fa 100644
--- a/test-suite/tester-clsql.cl
+++ b/test-suite/tester-clsql.cl
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Mar 2002
 ;;;;
-;;;; $Id: tester-clsql.cl,v 1.4 2002/04/10 04:57:28 kevin Exp $
+;;;; $Id: tester-clsql.cl,v 1.5 2002/04/19 20:25:20 marc.battyani Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,7 +23,7 @@
 ;;;
 ;;; ((:mysql ("localhost" "a-mysql-db" "user1" "secret"))
 ;;;  (:aodbc ("my-dsn" "a-user" "pass"))
-;;;  (:paostgresql ("localhost" "another-db" "user2" "dont-tell"))
+;;;  (:postgresql ("localhost" "another-db" "user2" "dont-tell"))
 ;;;  (:postgresql-socket ("pg-server" "a-db-name" "user" "secret-password")))