X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=aa7c6d79e0ad70f3b604a57356b47c8144e46839;hp=eb0d3b7e49df987488ac6a0158054286bba32457;hb=6b34e2293a52b03e8611c85e4e53a0ab5c8a3c1a;hpb=17255eb0ed45809a179853e9099d92d26d3717ac diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index eb0d3b7..aa7c6d7 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -99,7 +99,7 @@ likely that we'll have to worry about the CMUCL limit.")) (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 @@ -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 @@ -130,7 +155,7 @@ the length of that format.") (database (with-slots (errhp) database (let ((errcode (uffi:allocate-foreign-object 'sb4)) - (errbuf (uffi:allocate-foreign-string #.+errbuf-len+))) + (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))) @@ -144,8 +169,8 @@ the length of that format.") +errbuf-len+ +oci-htype-error+)) (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 @@ -341,7 +366,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 +405,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 +425,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)) @@ -469,46 +500,47 @@ the length of that format.") (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)) - 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) - (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))))) + (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 @@ -766,6 +798,7 @@ the length of that format.") (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+ @@ -774,27 +807,12 @@ the length of that format.") +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) @@ -805,13 +823,16 @@ the length of that format.") :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