(defmacro deref-vp (foreign-object)
`(the vp-type (uffi:deref-pointer (the vpp-type ,foreign-object) :pointer-void)))
-;; constants - from OCI?
-
(defvar +unsigned-char-null-pointer+
(uffi:make-null-pointer :unsigned-char))
(defvar +unsigned-short-null-pointer+
(defvar +unsigned-int-null-pointer+
(uffi:make-null-pointer :unsigned-int))
+;; constants - from OCI?
+
(defconstant +var-not-in-list+ 1007)
(defconstant +no-data-found+ 1403)
(defconstant +null-value-returned+ 1405)
:initarg :major-server-version
:reader major-server-version
:documentation
- "The major version number of the Oracle server, should be 8, 9, or 10")
- (client-version
- :type (or null string)
- :initarg :client-version
- :reader client-version
- :documentation
- "Version string of Oracle client.")
- (major-client-version
- :type (or null fixnum)
- :initarg :major-client-version
- :reader major-client-version
- :documentation
- "The major version number of the Oracle client, should be 8, 9, or 10")))
+ "The major version number of the Oracle server, should be 8, 9, or 10")))
;;; Handle the messy case of return code=+oci-error+, querying the
(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))
;; ensure errbuf empty string
(setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
- (uffi:ensure-char-storable (code-char 0)))
-
+ (uffi:ensure-char-storable (code-char 0)))
(setf (uffi:deref-pointer errcode :long) 0)
+
(uffi:with-cstring (sqlstate nil)
(oci-error-get (deref-vp errhp) 1
sqlstate
;;; Enabling this can be handy for low-level debugging.
#+nil
(progn
- (trace oci-initialize #+oci-8-1-5 oci-env-create oci-handle-alloc oci-logon
+ (trace #-oci7 oci-env-create oci-initialize oci-handle-alloc oci-logon
oci-error-get oci-stmt-prepare oci-stmt-execute
oci-param-get oci-logon oci-attr-get oci-define-by-pos oci-stmt-fetch)
(setf debug::*debug-print-length* nil))
(#.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))))
(#.SQLT-DATE
(deref-oci-string b irow (cd-sizeof cd))))))))
(when (and (eq :string (cd-result-type cd))
(deref-vp errhp))
(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) (plusp *precision)))
(setf buffer (acquire-foreign-resource :int +n-buf-rows+)
sizeof 4 ;; sizeof(int)
dtype #.SQLT-INT))
;; error-handling mechanism themselves) so we just assert they
;; work.
(setf (deref-vp envhp) +null-void-pointer+)
- #+oci-8-1-5
- (progn
- (oci-env-create envhp +oci-default+ +null-void-pointer+
- +null-void-pointer+ +null-void-pointer+
- +null-void-pointer+ 0 +null-void-pointer-pointer+)
- (oci-handle-alloc envhp
- (deref-vp errhp)
- +oci-htype-error+ 0
- +null-void-pointer-pointer+))
- #-oci-8-1-5
+ #-oci7
+ (oci-env-create envhp +oci-default+ +null-void-pointer+
+ +null-void-pointer+ +null-void-pointer+
+ +null-void-pointer+ 0 +null-void-pointer-pointer+)
+ #+oci7
(progn
(oci-initialize +oci-object+ +null-void-pointer+ +null-void-pointer+
+null-void-pointer+ +null-void-pointer-pointer+)
(ignore-errors (oci-handle-alloc +null-void-pointer+ envhp
+oci-htype-env+ 0
+null-void-pointer-pointer+)) ;no testing return
- (oci-env-init envhp +oci-default+ 0 +null-void-pointer-pointer+)
- (oci-handle-alloc (deref-vp envhp) errhp
- +oci-htype-error+ 0 +null-void-pointer-pointer+)
- (oci-handle-alloc (deref-vp envhp) srvhp
- +oci-htype-server+ 0 +null-void-pointer-pointer+)
- (uffi:with-cstring (dblink nil)
- (oci-server-attach (deref-vp srvhp)
- (deref-vp errhp)
- dblink
- 0 +oci-default+))
- (oci-handle-alloc (deref-vp envhp) svchp
- +oci-htype-svcctx+ 0 +null-void-pointer-pointer+)
- (oci-attr-set (deref-vp svchp)
- +oci-htype-svcctx+
- (deref-vp srvhp) 0 +oci-attr-server+
- (deref-vp errhp))
- ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0);
- ;;#+nil
- )
- ;; Actually, oci-server-version returns the client version, not the server versions
- ;; will use "SELECT VERSION FROM V$INSTANCE" to get actual server version.
- (let (db server-version client-version)
- (declare (ignorable server-version))
- (uffi:with-foreign-object (buf '(:array :unsigned-char #.+errbuf-len+))
- (oci-server-version (deref-vp svchp)
- (deref-vp errhp)
- (uffi:char-array-to-pointer buf)
- +errbuf-len+ +oci-htype-svcctx+)
- (setf client-version (uffi:convert-from-foreign-string buf))
- ;; This returns the client version, not the server version, so diable it
- #+ignore
- (oci-server-version (deref-vp srvhp)
- (deref-vp errhp)
- (uffi:char-array-to-pointer buf)
- +errbuf-len+ +oci-htype-server+)
- #+ignore
- (setf server-version (uffi:convert-from-foreign-string buf)))
- (setq db (make-instance 'oracle-database
- :name (database-name-from-spec connection-spec
- database-type)
- :connection-spec connection-spec
- :envhp envhp
- :errhp errhp
- :database-type :oracle
- :svchp svchp
- :dsn data-source-name
- :user user
- :client-version client-version
- :server-version server-version
- :major-client-version (major-client-version-from-string
- client-version)
- :major-server-version (major-client-version-from-string
- server-version)))
+ (oci-env-init envhp +oci-default+ 0 +null-void-pointer-pointer+))
+ (oci-handle-alloc (deref-vp envhp) errhp
+ +oci-htype-error+ 0 +null-void-pointer-pointer+)
+ (oci-handle-alloc (deref-vp envhp) srvhp
+ +oci-htype-server+ 0 +null-void-pointer-pointer+)
+
+ #+ignore ;; not used since CLSQL uses the OCILogon function instead
+ (uffi:with-cstring (dblink nil)
+ (oci-server-attach (deref-vp srvhp)
+ (deref-vp errhp)
+ dblink
+ 0 +oci-default+))
+
+ (oci-handle-alloc (deref-vp envhp) svchp
+ +oci-htype-svcctx+ 0 +null-void-pointer-pointer+)
+ (oci-attr-set (deref-vp svchp)
+ +oci-htype-svcctx+
+ (deref-vp srvhp) 0 +oci-attr-server+
+ (deref-vp errhp))
+ ;; oci-handle-alloc((dvoid *)encvhp, (dvoid **)&stmthp, OCI_HTYPE_STMT, 0, 0);
+ ;;#+nil
+
+ (let ((db (make-instance 'oracle-database
+ :name (database-name-from-spec connection-spec
+ database-type)
+ :connection-spec connection-spec
+ :envhp envhp
+ :errhp errhp
+ :database-type :oracle
+ :svchp svchp
+ :dsn data-source-name
+ :user user)))
(oci-logon (deref-vp envhp)
(deref-vp errhp)
svchp
(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