(date-format
:initarg :date-format
:reader date-format
- :initform "YYYY-MM-DD HH24:MI:SS\"+00\"")
+ :initform "YYYY-MM-DD HH24:MI:SS\".0\"")
(date-format-length
:type number
:documentation
:documentation
"The major version number of the Oracle server, should be 8, 9, or 10")))
+;;; Handle a non-successful result from an OCI function.
+(defun handle-oci-result (result database nulls-ok)
+ (case result
+ (#.+oci-success+
+ +oci-success+)
+ (#.+oci-error+
+ (handle-oci-error :database database :nulls-ok nulls-ok))
+ (#.+oci-no-data+
+ (error 'sql-database-error :message "OCI No Data Found"))
+ (#.+oci-success-with-info+
+ (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
+ (#.+oci-invalid-handle+
+ (error 'sql-database-error :message "OCI Invalid Handle"))
+ (#.+oci-need-data+
+ (error 'sql-database-error :message "OCI Need Data"))
+ (#.+oci-still-executing+
+ (error 'sql-temporary-error :message "OCI Still Executing"))
+ (#.+oci-continue+
+ (error 'sql-database-error :message "OCI Continue"))
+ (1804
+ (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
+ (t
+ (error 'sql-database-error
+ :message
+ (format nil "OCI unknown error, code=~A" result)))))
;;; Handle the messy case of return code=+oci-error+, querying the
;;; system for subcodes and reporting them as appropriate. ERRHP and
(cond
(database
(with-slots (errhp) database
- (let ((errcode (uffi:allocate-foreign-string :long))
- (errbuf (uffi:allocate-foreign-string #.+errbuf-len+)))
+ (let ((errcode (uffi:allocate-foreign-object 'sb4))
+ (errbuf (uffi:allocate-foreign-string #.+errbuf-len+)))
;; ensure errbuf empty string
(setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
(uffi:ensure-char-storable (code-char 0)))
- (setf (uffi:deref-pointer errcode :long) 0)
+ (setf (uffi:deref-pointer errcode 'sb4) 0)
(uffi:with-cstring (sqlstate nil)
(oci-error-get (deref-vp errhp) 1
errcode
(uffi:char-array-to-pointer errbuf)
+errbuf-len+ +oci-htype-error+))
- (let ((subcode (uffi:deref-pointer errcode :long))
+ (let ((subcode (uffi:deref-pointer errcode 'sb4))
(errstr (uffi:convert-from-foreign-string errbuf)))
- (uffi:free-foreign-object errcode)
- (uffi:free-foreign-object errbuf)
+ (uffi:free-foreign-object errcode)
+ (uffi:free-foreign-object errbuf)
(unless (and nulls-ok (= subcode +null-value-returned+))
(error 'sql-database-error
:database database
;; STREAM which has no more data, and QC is not a STREAM, we signal
;; DBI-ERROR instead.
-(uffi:def-type short-array (:array :short))
+(uffi:def-type short-array (:array :short nil))
+(uffi:def-type int-array (:array :int nil))
+(uffi:def-type double-array (:array :double nil))
(uffi:def-type int-pointer (* :int))
(uffi:def-type double-pointer (* :double))
(defun fetch-row (qc &optional (eof-errorp t) eof-value)
- ;;(declare (optimize (speed 3)))
+ (declare (optimize (speed 3)))
(cond ((zerop (qc-n-from-oci qc))
(if eof-errorp
(error 'sql-database-error :message
(value
(let* ((arb (foreign-resource-buffer (cd-indicators cd)))
(indicator (uffi:deref-array arb '(:array :short) irow)))
- ;;(declare (type short-array arb))
+ (declare (type short-array arb))
(unless (= indicator -1)
(ecase (cd-oci-data-type cd)
(#.SQLT-STR
(deref-oci-string b irow (cd-sizeof cd)))
(#.SQLT-FLT
- (uffi:deref-array b '(:array :double) irow))
+ (locally
+ (declare (type double-array b))
+ (uffi:deref-array b '(:array :double) irow)))
(#.SQLT-INT
(ecase (cd-sizeof cd)
(4
- (uffi:deref-array b '(:array :int) irow))))
+ (locally
+ (declare (type int-array b))
+ (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))
(values))
(#.+oci-error+ (handle-oci-error :database (qc-db qc)
:nulls-ok t))))
- (uffi:with-foreign-object (rowcount :long)
+ (uffi:with-foreign-object (rowcount 'ub4)
(oci-attr-get (deref-vp (qc-stmthp qc))
+oci-htype-stmt+
rowcount
+oci-attr-row-count+
(deref-vp errhp))
(setf (qc-n-from-oci qc)
- (- (uffi:deref-pointer rowcount :long)
+ (- (uffi:deref-pointer rowcount 'ub4)
(qc-total-n-from-oci qc)))
(when (< (qc-n-from-oci qc) +n-buf-rows+)
(setf (qc-oci-end-seen-p qc) t))
(setf (qc-total-n-from-oci qc)
- (uffi:deref-pointer rowcount :long)))))
+ (uffi:deref-pointer rowcount 'ub4)))))
(values)))
;; the guts of the SQL function
(defun sql-stmt-exec (sql-stmt-string db result-types field-names)
(with-slots (envhp svchp errhp) db
- (let ((stmthp (uffi:allocate-foreign-object :pointer-void)))
- (uffi:with-foreign-object (stmttype :unsigned-short)
-
- (unwind-protect
- (progn
- (oci-handle-alloc (deref-vp envhp)
- stmthp
- +oci-htype-stmt+ 0 +null-void-pointer-pointer+)
- (oci-stmt-prepare (deref-vp stmthp)
- (deref-vp errhp)
- (uffi:convert-to-cstring sql-stmt-string)
- (length sql-stmt-string)
- +oci-ntv-syntax+ +oci-default+ :database db)
- (oci-attr-get (deref-vp stmthp)
- +oci-htype-stmt+
- stmttype
- +unsigned-int-null-pointer+
- +oci-attr-stmt-type+
- (deref-vp errhp)
- :database db)
-
- (let* ((select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1))
- (iters (if select-p 0 1)))
-
- (oci-stmt-execute (deref-vp svchp)
- (deref-vp stmthp)
- (deref-vp errhp)
- iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+
- :database db)))
- ;; free resources unless a query
- (unless select-p
- (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+)
- (uffi:free-foreign-object stmthp))))
-
- (cond
- (select-p
- (make-query-cursor db stmthp result-types field-names))
- (t
- nil)))))
+ (uffi:with-foreign-strings ((c-stmt-string sql-stmt-string))
+ (let ((stmthp (uffi:allocate-foreign-object :pointer-void))
+ select-p)
+
+ (uffi:with-foreign-object (stmttype :unsigned-short)
+ (unwind-protect
+ (progn
+ (oci-handle-alloc (deref-vp envhp)
+ stmthp
+ +oci-htype-stmt+ 0 +null-void-pointer-pointer+)
+ (oci-stmt-prepare (deref-vp stmthp)
+ (deref-vp errhp)
+ c-stmt-string
+ (length sql-stmt-string)
+ +oci-ntv-syntax+ +oci-default+ :database db)
+ (oci-attr-get (deref-vp stmthp)
+ +oci-htype-stmt+
+ stmttype
+ +unsigned-int-null-pointer+
+ +oci-attr-stmt-type+
+ (deref-vp errhp)
+ :database db)
+
+ (setq select-p (= (uffi:deref-pointer stmttype :unsigned-short) 1))
+ (let ((iters (if select-p 0 1)))
+
+ (oci-stmt-execute (deref-vp svchp)
+ (deref-vp stmthp)
+ (deref-vp errhp)
+ iters 0 +null-void-pointer+ +null-void-pointer+ +oci-default+
+ :database db)))
+ ;; free resources unless a query
+ (unless select-p
+ (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+)
+ (uffi:free-foreign-object stmthp))))
+
+ (cond
+ (select-p
+ (make-query-cursor db stmthp result-types field-names))
+ (t
+ nil))))))
;; Return a QUERY-CURSOR representing the table returned from the OCI
;; the Oracle 9i OCI documentation. -- JJB 20040713
(uffi:def-type byte-pointer (* :byte))
-(uffi:def-type ulong-pointer (* :unsigned-long))
(uffi:def-type void-pointer-pointer (* :void-pointer))
(defun make-query-cursor-cds (database stmthp result-types field-names)
(precision :short)
(scale :byte)
(colname '(* :unsigned-char))
- (colnamelen :unsigned-long)
- (colsize :unsigned-short)
- (colsizesize :unsigned-long)
+ (colnamelen 'ub4)
+ (colsize 'ub2)
+ (colsizesize 'ub4)
(defnp ':pointer-void))
(let ((buffer nil)
(sizeof nil))
(deref-vp errhp))
(setq colname-string (uffi:convert-from-foreign-string
(uffi:deref-pointer colname '(* :unsigned-char))
- :length (uffi:deref-pointer colnamelen :unsigned-long))))
+ :length (uffi:deref-pointer colnamelen 'ub4))))
(push (make-cd :name colname-string
:sizeof sizeof
:buffer buffer
(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+
+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+)
- #+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)
:svchp svchp
:dsn data-source-name
:user user)))
- (oci-logon (deref-vp envhp)
- (deref-vp errhp)
- svchp
- (uffi:convert-to-cstring user) (length user)
- (uffi:convert-to-cstring password) (length password)
- (uffi:convert-to-cstring data-source-name) (length data-source-name)
- :database db)
+ (uffi:with-foreign-strings ((c-user user)
+ (c-password password)
+ (c-data-source-name data-source-name))
+ (oci-logon (deref-vp envhp)
+ (deref-vp errhp)
+ svchp
+ c-user (length user)
+ c-password (length password)
+ c-data-source-name (length data-source-name)
+ :database db))
;; :date-format-length (1+ (length date-format)))))
(setf (slot-value db 'clsql-sys::state) :open)
(database-execute-command
projects / clsql.git / blobdiff