* 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.
-24 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
+25 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
+ * 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
* 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
* 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
24 May 2004: Marcus Pearce (m.t.pearce@city.ac.uk)
* db-postgresql-socket/postgresql-socket-sql.lisp: replace
* 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
* 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
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
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.
(defun %insert-foreign-resource (type res)
(let ((resource (gethash type *foreign-resource-hash*)))
(setf (gethash type *foreign-resource-hash*)
(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*)))))
(defmacro acquire-foreign-resource (type &optional size)
`(let ((res (%get-resource ,type ,size)))
(defmacro acquire-foreign-resource (type &optional size)
`(let ((res (%get-resource ,type ,size)))
(defun handle-oci-error (&key database nulls-ok)
(cond (database
(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))
(uffi:with-foreign-objects ((errbuf '(:array :unsigned-char
#.+errbuf-len+))
(errcode :long))
(defmethod database-execute-command (sql-expression (database oracle-database))
(database-query sql-expression database nil nil)
(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))
do (setf (nth i list) (nth i row)))
list)))
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))
- )
-
-;;(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
(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)
-(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))
(call-next-method)
(osucc (oci-trans-rollback (deref-vp (svchp database))
(deref-vp (errhp database))
(database-type :initarg :database-type :initform :unknown
:reader database-type)
(state :initform :closed :reader database-state)
(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)
(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)
(declare (ignore database args db-type))
"INT8")
(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."
-(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
(defmethod database-get-type-specifier ((type (eql 'float)) args database db-type)
(declare (ignore database db-type))
(if args
(declare (ignore args database db-type))
"BOOL")
(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)
(defmethod database-output-sql-as-type (type val database db-type)
(declare (ignore type database db-type))
val)
(declare (ignore database db-type))
val)
(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))
(defmethod read-sql-value (val (type (eql 'keyword)) database db-type)
(declare (ignore database db-type))
(when (< 0 (length val))
(declare (ignore database db-type))
(equal "t" val))
(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)
(defmethod read-sql-value (val (type (eql 'univeral-time)) database db-type)
(declare (ignore database db-type))
(unless (eq 'NULL val)
#:database-type
#:database-state
#:attribute-cache
#:database-type
#:database-state
#:attribute-cache
+ #:database-autocommit
+
;; utils.lisp
#:without-interrupts
#:make-process-lock
;; utils.lisp
#:without-interrupts
#:make-process-lock
#:database-commit-transaction
#:transaction-level
#:transaction
#:database-commit-transaction
#:transaction-level
#:transaction
;; OODDL (ooddl.lisp)
#:standard-db-object
;; OODDL (ooddl.lisp)
#:standard-db-object
(defclass transaction ()
((commit-hooks :initform () :accessor commit-hooks)
(rollback-hooks :initform () :accessor rollback-hooks)
(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)
(defun add-transaction-commit-hook (database commit-hook)
(when (transaction database)
(defmethod database-start-transaction ((database database))
(unless (transaction database)
(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)
(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))
(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)))
- :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))
(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)
(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))))
- :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,
(defmacro with-transaction ((&key (database '*default-database*)) &rest body)
"Starts a transaction in the database specified by DATABASE,
(progn
(database-start-transaction ,db)
,@body
(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))))))
(if (eq (transaction-status (transaction ,db)) :committed)
(database-commit-transaction ,db)
(database-abort-transaction ,db))))))
*DEFAULT-DATABASE*, is currently within the scope of a
transaction."
(and database (transaction database) (= (transaction-level database) 1)))
*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))
projects / clsql.git / commitdiff