(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))
(setf debug::*debug-print-length* nil))
-;;;; the OCI library, part V: converting from OCI representations to Lisp
-;;;; representations
-
;; Return the INDEXth string of the OCI array, represented as Lisp
;; SIMPLE-STRING. SIZE is the size of the fixed-width fields used by
;; Oracle to store strings within the array.
-;; In the wild world of databases, trailing spaces aren't generally
-;; significant, since e.g. "LARRY " and "LARRY " are the same string
-;; stored in different fixed-width fields. OCI drops trailing spaces
-;; for us in some cases but apparently not for fields of fixed
-;; character width, e.g.
-;;
-;; (dbi:sql "create table employees (name char(15), job char(15), city
-;; char(15), rate float)" :db orcl :types :auto)
-;; In order to map the "same string" property above onto Lisp equality,
-;; we drop trailing spaces in all cases:
-
(uffi:def-type string-pointer (* :unsigned-char))
(defun deref-oci-string (arrayptr string-index size)
(declare (type string-pointer arrayptr))
(declare (type (mod #.+n-buf-rows+) string-index))
(declare (type (and unsigned-byte fixnum) size))
- (let* ((raw (uffi:convert-from-foreign-string
- (uffi:make-pointer
- (+ (uffi:pointer-address arrayptr) (* string-index size))
- :unsigned-char)))
- (trimmed (string-trim " " raw)))
- (if (equal trimmed "NULL") nil trimmed)))
+ (let ((str (uffi:convert-from-foreign-string
+ (uffi:make-pointer
+ (+ (uffi:pointer-address arrayptr) (* string-index size))
+ :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
(#.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)
)
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
(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))
projects / clsql.git / blobdiff