From 333e8280f2f3438ffd379349bc9746c34cccc159 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Tue, 25 May 2004 07:13:17 +0000 Subject: [PATCH] r9471: 5 May 2004 Kevin Rosenberg * Version 2.11.0 released: Full Oracle support. All tests pass * db-oracle/oracle-sql.lisp: Add declaration so that SBCL runs efficiently. * tests/test-init.lisp: capitalize odbc backend name in banner * CONTRIBUTORS: Add note about Marcus' excellent work * sql/oodml.lisp: Removed old stub function * clsql.asd: Use module names in current package rather than keyword package * db-oracle/oracle-sql.lisp: Don't trim trailing spaces. Prevent interrupts in setting sequence position. Make autocommits more efficient. * tests/test-init.lisp: Skip 2 tests on Oracle which have unsupported syntax * sql/oodml.lisp: Get rid of undocumented raw-string type. CommonSQL strings are raw (non-trimmed trailing whitespace). Add database-get-type-specifier and read-sql-value for NUMBER and CHAR. * sql/base-classes.lisp: Add autocommit slot * sql/transaction.lisp: Added autocommit processing, mild cleaning. --- ChangeLog | 10 ++++-- TODO | 8 ++--- db-oracle/foreign-resources.lisp | 2 +- db-oracle/oracle-sql.lisp | 42 ++++++++++++----------- sql/base-classes.lisp | 1 + sql/oodml.lisp | 40 +++++++++++++++------- sql/package.lisp | 4 ++- sql/transaction.lisp | 58 +++++++++++++++++++++----------- 8 files changed, 104 insertions(+), 61 deletions(-) diff --git a/ChangeLog b/ChangeLog index ef4b54b..2a994e8 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,12 +1,18 @@ -24 May 2004 Kevin Rosenberg +25 May 2004 Kevin Rosenberg + * Version 2.11.0 released: Full Oracle support. All tests pass * db-oracle/oracle-sql.lisp: Add declaration so that SBCL runs efficiently. * tests/test-init.lisp: capitalize odbc backend name in banner * CONTRIBUTORS: Add note about Marcus' excellent work * sql/oodml.lisp: Removed old stub function * clsql.asd: Use module names in current package rather than keyword package * db-oracle/oracle-sql.lisp: Don't trim trailing spaces. Prevent interrupts - in setting sequence position + in setting sequence position. Make autocommits more efficient. * tests/test-init.lisp: Skip 2 tests on Oracle which have unsupported syntax + * sql/oodml.lisp: Get rid of undocumented raw-string type. CommonSQL + strings are raw (non-trimmed trailing whitespace). Add database-get-type-specifier + and read-sql-value for NUMBER and CHAR. + * sql/base-classes.lisp: Add autocommit slot + * sql/transaction.lisp: Added autocommit processing, mild cleaning. 24 May 2004: Marcus Pearce (m.t.pearce@city.ac.uk) * db-postgresql-socket/postgresql-socket-sql.lisp: replace diff --git a/TODO b/TODO index 53afb2f..37c1829 100644 --- a/TODO +++ b/TODO @@ -11,18 +11,16 @@ TESTS TO ADD * owner phrases for postgresql and oracle backends * test of large table with large numbers of rows, greater than 2x the number of rows (200) returned by the oracle backend at a time +* Number and Char field types COMMONSQL INCOMPATIBILITY - o doesn't support CHAR and NUMBER types as shown on CREATE-TABLE reference page - o (string n) => VARCHAR(n) rather than CHAR(n) o userenv (Oracle specific but deprecated in Oracle 9) VARIANCES FROM COMMONSQL -COMMIT,ROLLBACK,START-TRANSACTION: - When COMMIT or ROLLBACK are called outside of WITH-TRANSACTION, an sql - transaction must be explicitly started first with START-TRANSACTION. +CLSQL starts with in transaction AUTOCOMMIT mode. To begin a transaction, +START-TRANSACTION has to be called. OPTIMIZATIONS diff --git a/db-oracle/foreign-resources.lisp b/db-oracle/foreign-resources.lisp index 919a211..badfedc 100644 --- a/db-oracle/foreign-resources.lisp +++ b/db-oracle/foreign-resources.lisp @@ -36,7 +36,7 @@ (defun %insert-foreign-resource (type res) (let ((resource (gethash type *foreign-resource-hash*))) (setf (gethash type *foreign-resource-hash*) - (cons res (gethash type *foreign-resource-hash*))))) + (cons res resource)))) (defmacro acquire-foreign-resource (type &optional size) `(let ((res (%get-resource ,type ,size))) diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index b5876d4..8ef4602 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -139,8 +139,7 @@ the length of that format.") (defun handle-oci-error (&key database nulls-ok) (cond (database - (with-slots (errhp) - database + (with-slots (errhp) database (uffi:with-foreign-objects ((errbuf '(:array :unsigned-char #.+errbuf-len+)) (errcode :long)) @@ -924,8 +923,8 @@ the length of that format.") (defmethod database-execute-command (sql-expression (database oracle-database)) (database-query sql-expression database nil nil) - ;; HACK HACK HACK - (database-query "commit" database nil nil) + (when (database-autocommit database) + (oracle-commit database)) t) @@ -993,27 +992,30 @@ the length of that format.") do (setf (nth i list) (nth i row))) list))) -(defmethod clsql-sys:database-start-transaction ((database oracle-database)) +(defmethod database-start-transaction ((database oracle-database)) (call-next-method) - ) - -;;(with-slots (svchp errhp) database -;; (osucc (oci-trans-start (uffi:deref-pointer svchp) -;; (uffi:deref-pointer errhp) -;; 60 -;; +oci-trans-new+))) -;; t) - + ;; Not needed with simple transaction + #+ignore + (with-slots (svchp errhp) database + (oci-trans-start (deref-vp svchp) + (deref-vp errhp) + 60 + +oci-trans-new+)) + t) -(defmethod clsql-sys:database-commit-transaction ((database oracle-database)) - (call-next-method) + +(defun oracle-commit (database) (with-slots (svchp errhp) database - (osucc (oci-trans-commit (deref-vp svchp) - (deref-vp errhp) - 0))) + (osucc (oci-trans-commit (deref-vp svchp) + (deref-vp errhp) + 0)))) + +(defmethod database-commit-transaction ((database oracle-database)) + (call-next-method) + (oracle-commit database) t) -(defmethod clsql-sys:database-abort-transaction ((database oracle-database)) +(defmethod database-abort-transaction ((database oracle-database)) (call-next-method) (osucc (oci-trans-rollback (deref-vp (svchp database)) (deref-vp (errhp database)) diff --git a/sql/base-classes.lisp b/sql/base-classes.lisp index 4e33010..87833fc 100644 --- a/sql/base-classes.lisp +++ b/sql/base-classes.lisp @@ -29,6 +29,7 @@ (database-type :initarg :database-type :initform :unknown :reader database-type) (state :initform :closed :reader database-state) + (autocommit :initform t :accessor database-autocommit) (command-recording-stream :accessor command-recording-stream :initform nil) (result-recording-stream :accessor result-recording-stream :initform nil) (record-caches :accessor record-caches :initform nil) diff --git a/sql/oodml.lisp b/sql/oodml.lisp index 960dbd2..e2f6b48 100644 --- a/sql/oodml.lisp +++ b/sql/oodml.lisp @@ -367,16 +367,11 @@ (declare (ignore database args db-type)) "INT8") -(deftype raw-string (&optional len) - "A string which is not trimmed when retrieved from the database" +#+ignore +(deftype char (&optional len) + "A lisp type for the SQL CHAR type." `(string ,len)) -(defmethod database-get-type-specifier ((type (eql 'raw-string)) args database db-type) - (declare (ignore database db-type)) - (if args - (format nil "VARCHAR(~A)" (car args)) - "VARCHAR")) - (defmethod database-get-type-specifier ((type (eql 'float)) args database db-type) (declare (ignore database db-type)) (if args @@ -393,6 +388,23 @@ (declare (ignore args database db-type)) "BOOL") +(defmethod database-get-type-specifier ((type (eql 'number)) args database db-type) + (declare (ignore database db-type)) + (cond + ((and (consp args) (= (length args) 2)) + (format nil "NUMBER(~D,~D)" (first args) (second args))) + ((and (consp args) (= (length args) 1)) + (format nil "NUMBER(~D)" (first args))) + (t + "NUMBER"))) + +(defmethod database-get-type-specifier ((type (eql 'char)) args database db-type) + (declare (ignore database db-type)) + (if args + (format nil "CHAR(~D)" (first args)) + "CHAR")) + + (defmethod database-output-sql-as-type (type val database db-type) (declare (ignore type database db-type)) val) @@ -465,10 +477,6 @@ (declare (ignore database db-type)) val) -(defmethod read-sql-value (val (type (eql 'raw-string)) database db-type) - (declare (ignore database db-type)) - val) - (defmethod read-sql-value (val (type (eql 'keyword)) database db-type) (declare (ignore database db-type)) (when (< 0 (length val)) @@ -511,6 +519,14 @@ (declare (ignore database db-type)) (equal "t" val)) +(defmethod read-sql-value (val (type (eql 'number)) database db-type) + (declare (ignore database db-type)) + (etypecase val + (string + (unless (string-equal "NIL" val) + (read-from-string val))) + (number val))) + (defmethod read-sql-value (val (type (eql 'univeral-time)) database db-type) (declare (ignore database db-type)) (unless (eq 'NULL val) diff --git a/sql/package.lisp b/sql/package.lisp index 34a01bf..c180f46 100644 --- a/sql/package.lisp +++ b/sql/package.lisp @@ -177,7 +177,8 @@ #:database-type #:database-state #:attribute-cache - + #:database-autocommit + ;; utils.lisp #:without-interrupts #:make-process-lock @@ -317,6 +318,7 @@ #:database-commit-transaction #:transaction-level #:transaction + #:autocommit ;; OODDL (ooddl.lisp) #:standard-db-object diff --git a/sql/transaction.lisp b/sql/transaction.lisp index 286839b..d41d6ef 100644 --- a/sql/transaction.lisp +++ b/sql/transaction.lisp @@ -17,12 +17,10 @@ (defclass transaction () ((commit-hooks :initform () :accessor commit-hooks) (rollback-hooks :initform () :accessor rollback-hooks) - (status :initform nil :accessor transaction-status))) ; nil or :committed - -(defun commit-transaction (database) - (when (and (transaction database) - (not (transaction-status (transaction database)))) - (setf (transaction-status (transaction database)) :committed))) + (previous-autocommit :initarg :previous-autocommit + :reader previous-autocommit) + (status :initform nil :accessor transaction-status + :documentation "nil or :committed"))) (defun add-transaction-commit-hook (database commit-hook) (when (transaction database) @@ -34,33 +32,47 @@ (defmethod database-start-transaction ((database database)) (unless (transaction database) - (setf (transaction database) (make-instance 'transaction))) + (setf (transaction database) + (make-instance 'transaction :previous-autocommit + (database-autocommit database)))) + (setf (database-autocommit database) nil) (when (= (incf (transaction-level database) 1)) (let ((transaction (transaction database))) (setf (commit-hooks transaction) nil (rollback-hooks transaction) nil (transaction-status transaction) nil) - (execute-command "BEGIN" :database database)))) + (unless (eq :oracle (database-underlying-type database)) + (execute-command "BEGIN" :database database))))) (defmethod database-commit-transaction ((database database)) - (if (> (transaction-level database) 0) - (when (zerop (decf (transaction-level database))) - (execute-command "COMMIT" :database database) - (map nil #'funcall (commit-hooks (transaction database)))) + (with-slots (transaction transaction-level autocommit) database + (if (plusp transaction-level) + (when (zerop (decf transaction-level)) + (execute-command "COMMIT" :database database) + (setf autocommit (previous-autocommit transaction)) + (map nil #'funcall (commit-hooks transaction))) (warn 'sql-warning - :format-control "Cannot commit transaction against ~A because there is no transaction in progress." - :format-arguments (list database)))) + :format-control + "Cannot commit transaction against ~A because there is no transaction in progress." + :format-arguments (list database))))) (defmethod database-abort-transaction ((database database)) - (if (> (transaction-level database) 0) - (when (zerop (decf (transaction-level database))) + (with-slots (transaction transaction-level autocommit) database + (if (plusp transaction-level) + (when (zerop (decf transaction-level)) (unwind-protect (execute-command "ROLLBACK" :database database) - (map nil #'funcall (rollback-hooks (transaction database))))) + (setf autocommit (previous-autocommit transaction)) + (map nil #'funcall (rollback-hooks transaction)))) (warn 'sql-warning - :format-control "Cannot abort transaction against ~A because there is no transaction in progress." - :format-arguments (list database)))) + :format-control + "Cannot abort transaction against ~A because there is no transaction in progress." + :format-arguments (list database))))) +(defun mark-transaction-committed (database) + (when (and (transaction database) + (not (transaction-status (transaction database)))) + (setf (transaction-status (transaction database)) :committed))) (defmacro with-transaction ((&key (database '*default-database*)) &rest body) "Starts a transaction in the database specified by DATABASE, @@ -73,7 +85,7 @@ back and otherwise the transaction is committed." (progn (database-start-transaction ,db) ,@body - (commit-transaction ,db)) + (mark-transaction-committed ,db)) (if (eq (transaction-status (transaction ,db)) :committed) (database-commit-transaction ,db) (database-abort-transaction ,db)))))) @@ -102,3 +114,9 @@ are called." *DEFAULT-DATABASE*, is currently within the scope of a transaction." (and database (transaction database) (= (transaction-level database) 1))) + +(defun autocommit (&key (database *default-database*) (set :unspecified)) + "Returns whether autocommit is currently active." + (unless (eq set :unspecified) + (setf (database-autocommit database) set)) + (database-autocommit database)) -- 2.34.1