(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))
: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
(#.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))
(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)
(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)
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))