From: Marc Battyani Date: Fri, 10 May 2002 08:05:48 +0000 (+0000) Subject: r1989: Moddified transactions X-Git-Tag: v3.8.6~1121 X-Git-Url: http://git.kpe.io/?p=clsql.git;a=commitdiff_plain;h=e930501699cd43183e458fdc1bbfd45dd4094344 r1989: Moddified transactions --- diff --git a/ChangeLog b/ChangeLog index 99cf1dd..3da17ea 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +10 May 2002 Marc Battyani (marc.battyani@fractalconcept.com) + * sql/classes.cl: + * sql/transactions.cl: + Added transaction support. Functions/macros added: + with-transaction, commit-transaction, rollback-transaction, + add-transaction-commit-hook, add-transaction-rollback-hook + 04 May 2002 Marc Battyani (marc.battyani@fractalconcept.com) * sql/sql.cl: * sql/pool.cl: diff --git a/interfaces/postgresql/postgresql-sql.cl b/interfaces/postgresql/postgresql-sql.cl index 809507c..7e9d6e8 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.15 2002/04/27 20:58:11 kevin Exp $ +;;;; $Id: postgresql-sql.cl,v 1.16 2002/05/10 08:05:48 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 @@ -285,23 +285,22 @@ (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)) +(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))) + (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)) ;; (MB) the begin/commit/rollback stuff will be removed when with-transaction wil be implemented diff --git a/sql/package.cl b/sql/package.cl index 48e4542..f811926 100644 --- a/sql/package.cl +++ b/sql/package.cl @@ -1 +1 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.cl ;;;; Purpose: Package definition for high-level SQL interface ;;;; Programmers: Kevin M. Rosenberg based on ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; ;;;; $Id: package.cl,v 1.12 2002/05/08 16:56:54 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 ;;;; ;;;; 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. ;;;; ************************************************************************* (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :cl-user) ;;;; This file makes the required package definitions for CLSQL's ;;;; core packages. ;;;; (eval-when (:compile-toplevel :load-toplevel :execute) (defpackage :clsql-sys (:use :common-lisp) (:export ;; "Private" exports for use by interface packages #:check-connection-spec #:database-type-load-foreign #:database-type-library-loaded ;; KMR - Tests if foreign library okay #:database-initialize-database-type #:database-connect #:database-disconnect #:database-query #:database-execute-command #:database-query-result-set #:database-dump-result-set #:database-store-next-row ;; For UncommonSQL support #:database-list-tables #:database-list-attributes #:database-attribute-type #:database-create-sequence #:database-drop-sequence #:database-sequence-next #:sql-escape ;; Support for pooled connections #:database-type ;; 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 #:clsql-error #:clsql-simple-error #:clsql-warning #:clsql-simple-warning #:clsql-invalid-spec-error #:clsql-invalid-spec-error-connection-spec #:clsql-invalid-spec-error-database-type #:clsql-invalid-spec-error-template #:clsql-connect-error #:clsql-connect-error-database-type #:clsql-connect-error-connection-spec #:clsql-connect-error-errno #:clsql-connect-error-error #:clsql-sql-error #:clsql-sql-error-database #:clsql-sql-error-expression #:clsql-sql-error-errno #:clsql-sql-error-error #:clsql-database-warning #:clsql-database-warning-database #:clsql-database-warning-message #:clsql-exists-condition #:clsql-exists-condition-new-db #:clsql-exists-condition-old-db #:clsql-exists-warning #:clsql-exists-error #:clsql-closed-error #:clsql-closed-error-database #:*loaded-database-types* #:reload-database-types #:*default-database-type* #:*initialized-database-types* #:initialize-database-type #:*connect-if-exists* #:*default-database* #:connected-databases #:database #:database-name #:closed-database #:find-database #:database-name-from-spec #:connect #:disconnect #:query #:execute-command #:map-query #:do-query ;; functional.cl #:insert-records #:delete-records #:update-records #:with-database ;; utils.cl #:number-to-sql-string #:float-to-sql-string #:sql-escape-quotes ;; For UncommonSQL support #:sql-ident #:list-tables #:list-attributes #:attribute-type #:create-sequence #:drop-sequence #:sequence-next #:transaction-start #:transaction-commit #:transaction-abort ;; Pooled connections #:disconnect-pooled ;; Transactions #:with-transaction ;; 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.")) (defpackage #:clsql (:import-from #:clsql-sys . #1#) (:export . #1#) (:documentation "This is the SQL-Interface package of CLSQL.")) );eval-when (defpackage #:clsql-user (:use #:common-lisp #:clsql) (:documentation "This is the user package for experimenting with CLSQL.")) \ No newline at end of file +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: package.cl ;;;; Purpose: Package definition for high-level SQL interface ;;;; Programmers: Kevin M. Rosenberg based on ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; ;;;; $Id: package.cl,v 1.13 2002/05/10 08:05:48 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 ;;;; ;;;; 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. ;;;; ************************************************************************* (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :cl-user) ;;;; This file makes the required package definitions for CLSQL's ;;;; core packages. ;;;; (eval-when (:compile-toplevel :load-toplevel :execute) (defpackage :clsql-sys (:use :common-lisp) (:export ;; "Private" exports for use by interface packages #:check-connection-spec #:database-type-load-foreign #:database-type-library-loaded ;; KMR - Tests if foreign library okay #:database-initialize-database-type #:database-connect #:database-disconnect #:database-query #:database-execute-command #:database-query-result-set #:database-dump-result-set #:database-store-next-row ;; For UncommonSQL support #:database-list-tables #:database-list-attributes #:database-attribute-type #:database-create-sequence #:database-drop-sequence #:database-sequence-next #:sql-escape ;; Support for pooled connections #:database-type ;; 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 #:clsql-error #:clsql-simple-error #:clsql-warning #:clsql-simple-warning #:clsql-invalid-spec-error #:clsql-invalid-spec-error-connection-spec #:clsql-invalid-spec-error-database-type #:clsql-invalid-spec-error-template #:clsql-connect-error #:clsql-connect-error-database-type #:clsql-connect-error-connection-spec #:clsql-connect-error-errno #:clsql-connect-error-error #:clsql-sql-error #:clsql-sql-error-database #:clsql-sql-error-expression #:clsql-sql-error-errno #:clsql-sql-error-error #:clsql-database-warning #:clsql-database-warning-database #:clsql-database-warning-message #:clsql-exists-condition #:clsql-exists-condition-new-db #:clsql-exists-condition-old-db #:clsql-exists-warning #:clsql-exists-error #:clsql-closed-error #:clsql-closed-error-database #:*loaded-database-types* #:reload-database-types #:*default-database-type* #:*initialized-database-types* #:initialize-database-type #:*connect-if-exists* #:*default-database* #:connected-databases #:database #:database-name #:closed-database #:find-database #:database-name-from-spec #:connect #:disconnect #:query #:execute-command #:map-query #:do-query ;; functional.cl #:insert-records #:delete-records #:update-records #:with-database ;; utils.cl #:number-to-sql-string #:float-to-sql-string #:sql-escape-quotes ;; For UncommonSQL support #:sql-ident #:list-tables #:list-attributes #:attribute-type #:create-sequence #:drop-sequence #:sequence-next ;; Pooled connections #:disconnect-pooled ;; Transactions #:with-transaction #:commit-transaction #:rollback-transaction #:add-transaction-commit-hook #:add-transaction-rollback-hook ;; 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.")) (defpackage #:clsql (:import-from #:clsql-sys . #1#) (:export . #1#) (:documentation "This is the SQL-Interface package of CLSQL.")) );eval-when (defpackage #:clsql-user (:use #:common-lisp #:clsql) (:documentation "This is the user package for experimenting with CLSQL.")) \ No newline at end of file diff --git a/sql/transactions.cl b/sql/transactions.cl index 6b980aa..7717162 100644 --- a/sql/transactions.cl +++ b/sql/transactions.cl @@ -4,13 +4,12 @@ ;;;; ;;;; Name: transactions.cl ;;;; Purpose: Transaction support -;;;; Programmers: Kevin M. Rosenberg, Marc Battyani +;;;; Programmers: Marc Battyani ;;;; Date Started: Apr 2002 ;;;; -;;;; $Id: transactions.cl,v 1.2 2002/05/07 10:19:13 marc.battyani Exp $ +;;;; $Id: transactions.cl,v 1.3 2002/05/10 08:05:48 marc.battyani Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg -;;;; and Copyright (c) 2000-2002 by onShore Development ;;;; ;;;; CLSQL users are granted the rights to distribute and use this software ;;;; as governed by the terms of the Lisp Lesser GNU Public License @@ -25,7 +24,7 @@ (defclass transaction () ((commit-hooks :initform () :accessor commit-hooks) (rollback-hooks :initform () :accessor rollback-hooks) - (aborted :initform nil :accessor aborted))) + (status :initform nil :accessor status))) ;can be nil :rolled-back or :commited (defmethod database-start-transaction ((database closed-database)) (signal-closed-database-error database)) @@ -37,33 +36,35 @@ (let ((transaction (transaction database))) (setf (commit-hooks transaction) nil (rollback-hooks transaction) nil - (aborted transaction) nil) + (status transaction) nil) (execute-command "BEGIN" :database database)))) -(defmethod database-end-transaction ((database closed-database) commit) +(defmethod database-end-transaction ((database closed-database)) (signal-closed-database-error database)) -(defmethod database-end-transaction (database commit) - (when (not commit) - (setf (aborted (transaction database)) t)) +(defmethod database-end-transaction (database) (if (> (transaction-level database) 0) (when (zerop (decf (transaction-level database))) (let ((transaction (transaction database))) - (if (aborted transaction) - (unwind-protect - (execute-command "ROLLBACK" :database database) - (map nil #'funcall (rollback-hooks database))) + (if (eq (status transaction) :commited) (progn (execute-command "COMMIT" :database database) - (map nil #'funcall (commit-hooks transaction)))))) + (map nil #'funcall (commit-hooks transaction))) + (unwind-protect ;status is not :commited + (execute-command "ROLLBACK" :database database) + (map nil #'funcall (rollback-hooks database)))))) (warn "Continue without commit." 'clsql-simple-error :format-control "Cannot commit transaction against ~A because there is no transaction in progress." :format-arguments (list database)))) -(defun abort-transaction (database) - (when (transaction database) - (setf (aborted (transaction database)) t))) +(defun rollback-transaction (database) + (when (and (transaction database)(not (status (transaction database)))) + (setf (status (transaction database)) :rolled-back))) + +(defun commit-transaction (database) + (when (and (transaction database)(not (status (transaction database)))) + (setf (status (transaction database)) :commited))) (defun add-transaction-commit-hook (database abort-hook) (when (transaction database) @@ -73,16 +74,12 @@ (when (transaction database) (push rollback-hook (rollback-hooks (transaction database))))) -(defmacro with-transaction ((&key (database '*default-database*) abort-function) - &rest body) - (let ((db (gensym "db")) - (commit (gensym "commit-"))) - `(let ((,db ,database) - (,commit nil)) +(defmacro with-transaction ((&key (database '*default-database*)) &rest body) + (let ((db (gensym "db-"))) + `(let ((,db ,database)) (unwind-protect - (progn - (database-start-transaction ,db) - (setf ,commit t) - ,@body - (setf ,commit nil)) - (database-end-transaction ,db ,commit))))) + (progn + (start-transaction ,db) + ,@body + (commit-transaction ,db)) + (database-end-transaction ,db)))))