r9471: 5 May 2004 Kevin Rosenberg <kevin@rosenberg.net>
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 25 May 2004 07:13:17 +0000 (07:13 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 25 May 2004 07:13:17 +0000 (07:13 +0000)
        * 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
TODO
db-oracle/foreign-resources.lisp
db-oracle/oracle-sql.lisp
sql/base-classes.lisp
sql/oodml.lisp
sql/package.lisp
sql/transaction.lisp

index ef4b54b..2a994e8 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,12 +1,18 @@
-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
-       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 (file)
--- 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
  
index 919a211..badfedc 100644 (file)
@@ -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)))
index b5876d4..8ef4602 100644 (file)
@@ -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))
index 4e33010..87833fc 100644 (file)
@@ -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)
index 960dbd2..e2f6b48 100644 (file)
   (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
   (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)
   (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))
   (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)
index 34a01bf..c180f46 100644 (file)
      #:database-type
      #:database-state
      #:attribute-cache
-   
+     #:database-autocommit
+
      ;; utils.lisp
      #:without-interrupts
      #:make-process-lock
          #:database-commit-transaction
          #:transaction-level
          #:transaction
+        #:autocommit
 
         ;;  OODDL (ooddl.lisp) 
         #:standard-db-object               
index 286839b..d41d6ef 100644 (file)
 (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)
 
 (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))