X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=b18bad77e40fc22f35b9079fe02d8675e3e1de32;hb=0f707b093bdc29389f59db6e50441ac93f47b4b9;hp=e5f66e5406b61d84e46ceb4072fdb2529603d835;hpb=5f77ad867ac063e13531cb2c7c5625f68e770903;p=clsql.git diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index e5f66e5..b18bad7 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -120,6 +120,31 @@ the length of that format.") :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 @@ -129,12 +154,12 @@ the length of that format.") (cond (database (with-slots (errhp) database - (let ((errcode (uffi:allocate-foreign-object :long)) - (errbuf (uffi:allocate-foreign-string #.+errbuf-len+))) + (uffi:with-foreign-objects ((errcode 'sb4) + (errbuf '(:array :unsigned-char #.+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 @@ -142,10 +167,8 @@ the length of that format.") 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) (unless (and nulls-ok (= subcode +null-value-returned+)) (error 'sql-database-error :database database @@ -341,7 +364,9 @@ the length of that format.") ;; 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)) @@ -378,7 +403,7 @@ the length of that format.") (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 @@ -398,17 +423,21 @@ the length of that format.") (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)) @@ -436,7 +465,7 @@ the length of that format.") (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 @@ -444,12 +473,12 @@ the length of that format.") +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 @@ -597,7 +626,6 @@ the length of that format.") ;; 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) @@ -610,9 +638,9 @@ the length of that format.") (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)) @@ -693,7 +721,7 @@ the length of that format.") (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