X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=ac8ee155cf97a3cd2665c295e034cf1f87e3ab62;hb=645d2ea7396466b8673e3421b55e45cd327f0195;hp=9a7db75de7461afe46687ec1510a27819c177c38;hpb=7cc407732ccb8437d1b38f2d8cce2c648f98dd45;p=clsql.git diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 9a7db75..ac8ee15 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)) @@ -212,6 +211,21 @@ the length of that format.") :unsigned-char)))) (if (string-equal str "NULL") nil str))) +(defun deref-oci-int64 (arrayptr index) + (let ((low32 (uffi:deref-array arrayptr '(:array :unsigned-int) + (+ index index))) + (high32 (uffi:deref-array arrayptr '(:array :unsigned-int) + (+ 1 index index)))) + (make-64-bit-integer high32 low32))) + +(defun deref-oci-int128 (arrayptr index) + (let* ((base (* 4 index)) + (d (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (c (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (b (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base))) + (a (uffi:deref-array arrayptr '(:array :unsigned-int) (incf base)))) + (make-128-bit-integer a b c d))) + ;; the OCI library, part Z: no-longer used logic to convert from ;; Oracle's binary date representation to Common Lisp's native date ;; representation @@ -396,7 +410,13 @@ the length of that format.") (#.SQLT-FLT (uffi:deref-array b '(:array :double) irow)) (#.SQLT-INT - (uffi:deref-array b '(:array :int) irow)) + (ecase (cd-sizeof cd) + (4 + (uffi:deref-array b '(:array :int) irow)) + (8 + (deref-oci-int64 b irow)) + (16 + (deref-oci-int128 b irow)))) (#.SQLT-DATE (deref-oci-string b irow (cd-sizeof cd)))))))) (when (and (eq :string (cd-result-type cd)) @@ -627,13 +647,28 @@ the length of that format.") (let ((*scale (uffi:deref-pointer scale :byte)) (*precision (uffi:deref-pointer precision :byte))) - ;; (format t "scale=~d, precision=~d~%" *scale *precision) + ;;(format t "scale=~d, precision=~d~%" *scale *precision) (cond - ((or (and (zerop *scale) (not (zerop *precision))) - (and (minusp *scale) (< *precision 10))) + ((or (and (minusp *scale) (zerop *precision)) + (and (zerop *scale) (< 0 *precision 9))) (setf buffer (acquire-foreign-resource :int +n-buf-rows+) sizeof 4 ;; sizeof(int) dtype #.SQLT-INT)) + ((and (zerop *scale) + (plusp *precision) + #+ignore (< *precision 19)) + (setf buffer (acquire-foreign-resource :unsigned-int + (* 2 +n-buf-rows+)) + sizeof 8 ;; sizeof(int64) + dtype #.SQLT-INT)) + ;; Bug in OCI? But OCI won't take 16-byte buffer for 128-bit + ;; integers + #+ignore + ((and (zerop *scale) (plusp *precision)) + (setf buffer (acquire-foreign-resource :unsigned-int + (* 4 +n-buf-rows+)) + sizeof 8 ;; sizeof(int128) + dtype #.SQLT-INT)) (t (setf buffer (acquire-foreign-resource :double +n-buf-rows+) sizeof 8 ;; sizeof(double) @@ -901,17 +936,17 @@ the length of that format.") ) database :auto nil))) -;; FIXME: use lock (defmethod database-set-sequence-position (name position (database oracle-database)) - (let* ((next (database-sequence-next name database)) - (incr (- position next))) - (database-execute-command - (format nil "ALTER SEQUENCE ~A INCREMENT BY ~D" name incr) - database) - (database-sequence-next name database) - (database-execute-command - (format nil "ALTER SEQUENCE ~A INCREMENT BY 1" name) - database))) + (without-interrupts + (let* ((next (database-sequence-next name database)) + (incr (- position next))) + (database-execute-command + (format nil "ALTER SEQUENCE ~A INCREMENT BY ~D" name incr) + database) + (database-sequence-next name database) + (database-execute-command + (format nil "ALTER SEQUENCE ~A INCREMENT BY 1" name) + database)))) (defmethod database-list-sequences ((database oracle-database) &key owner) (let ((query @@ -924,8 +959,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 +1028,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))