X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=b18bad77e40fc22f35b9079fe02d8675e3e1de32;hb=0f707b093bdc29389f59db6e50441ac93f47b4b9;hp=2e86cce5da3b75d4fda4092edb2962b693ecd8ac;hpb=01873085a9374b33f76335a794324871536c823a;p=clsql.git diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 2e86cce..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,34 +154,34 @@ the length of that format.") (cond (database (with-slots (errhp) database - (uffi:with-foreign-object (errcode :long) - (let ((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) - - (uffi:with-cstring (sqlstate nil) - (oci-error-get (deref-vp errhp) 1 - sqlstate - errcode - (uffi:char-array-to-pointer errbuf) - +errbuf-len+ +oci-htype-error+)) - (let ((subcode (uffi:deref-pointer errcode :long))) - (unless (and nulls-ok (= subcode +null-value-returned+)) - (error 'sql-database-error - :database database - :error-id subcode - :message (uffi:convert-from-foreign-string errbuf)))) - (uffi:free-foreign-object errbuf))))) + (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 'sb4) 0) + + (uffi:with-cstring (sqlstate nil) + (oci-error-get (deref-vp errhp) 1 + sqlstate + errcode + (uffi:char-array-to-pointer errbuf) + +errbuf-len+ +oci-htype-error+)) + (let ((subcode (uffi:deref-pointer errcode 'sb4)) + (errstr (uffi:convert-from-foreign-string errbuf))) + (unless (and nulls-ok (= subcode +null-value-returned+)) + (error 'sql-database-error + :database database + :error-id subcode + :message errstr)))))) (nulls-ok - (error 'sql-database-error - :database database - :message "can't handle NULLS-OK without ERRHP")) - (t - (error 'sql-database-error - :database database - :message "OCI Error (and no ERRHP available to find subcode)")))) + (error 'sql-database-error + :database database + :message "can't handle NULLS-OK without ERRHP")) + (t + (error 'sql-database-error + :database database + :message "OCI Error (and no ERRHP available to find subcode)")))) ;;; Require an OCI success code. ;;; @@ -339,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)) @@ -376,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 @@ -396,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)) @@ -434,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 @@ -442,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 @@ -466,39 +497,47 @@ the length of that format.") ;; freeing the STMTHP when it is no longer needed. (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))) + (with-slots (envhp svchp errhp) db + (let ((stmthp (uffi:allocate-foreign-object :pointer-void)) + select-p) + (uffi:with-foreign-object (stmttype :unsigned-short) - - (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) - (cond (select-p - (make-query-cursor db stmthp result-types field-names)) - (t - (oci-handle-free (deref-vp stmthp) +oci-htype-stmt+) - nil))))))) + (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) + + (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 @@ -587,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) @@ -600,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)) @@ -683,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 @@ -714,6 +752,7 @@ the length of that format.") (defun close-query (qc) (oci-handle-free (deref-vp (qc-stmthp qc)) +oci-htype-stmt+) + (uffi:free-foreign-object (qc-stmthp qc)) (let ((cds (qc-cds qc))) (dotimes (i (length cds)) (release-cd-resources (aref cds i))))