r1781: Large objects support for Postgresql

diff --git a/interfaces/postgresql/postgresql-api.cl b/interfaces/postgresql/postgresql-api.cl
index 83ba30723d6b2dc2f77673b1fc90419602346b96..5f679619013db8f9ab25823c497565f41ff8d0fb 100644 (file)
--- 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 96f0bfb4a77d9c75ecbfb11cee192557136db203..22c4a3f862341c9503bd4316a2d7aedff03e299b 100644 (file)
--- 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 275ac39b360ac1358ac0f2e0effaceb7a56a2ae9..21cb247eed7b7defced65805d84835a814e59711 100644 (file)
--- 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 0fac5b28fd69ed0c4347d2519ff58ed416a91b33..1ce86816d597771845e83075b4152cd12ed33a3c 100644 (file)
--- 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 f816764927a10b701d60837d37863af53c4d8867..2db3c446215c5c078e11d67ee03666b056ea0195 100644 (file)
--- 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 f0d5bee86d16865e8efefa2b9cc9e808266c649f..4b88fd584118ec8f3eb3023bd5d4b1ab4f0c9d04 100644 (file)
--- 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 1ce4fef398550944e99ddd3fbd6f2b382c4aeaf4..08c51601ae22331cb029eb847c18d4bc9537abb4 100644 (file)
--- 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 f3e6bef7f4dcf0dce5429e7527a0e1b586345e2a..03045fadd19ba94de0524de0188516713780475b 100644 (file)
--- 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")))