X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle-api.lisp;h=3b0a7ee431c8f9c0b9ac2dae38850427af720971;hb=69e146090f7c78c4d51023c25a0c1a1eade224a1;hp=8f45da7e44945a1df12b1cd2a89bc95573a6ef44;hpb=17255eb0ed45809a179853e9099d92d26d3717ac;p=clsql.git diff --git a/db-oracle/oracle-api.lisp b/db-oracle/oracle-api.lisp index 8f45da7..3b0a7ee 100644 --- a/db-oracle/oracle-api.lisp +++ b/db-oracle/oracle-api.lisp @@ -37,9 +37,10 @@ (uffi:def-foreign-type oci-svc-ctx :pointer-void) (uffi:def-foreign-type oci-stmt :pointer-void) - -(defvar +null-void-pointer+ (uffi:make-null-pointer :void)) -(defvar +null-void-pointer-pointer+ (uffi:make-null-pointer :pointer-void)) +(uffi:def-pointer-var +null-void-pointer+ + (uffi:make-null-pointer :void)) +(uffi:def-pointer-var +null-void-pointer-pointer+ + (uffi:make-null-pointer :pointer-void)) ;;; Check an OCI return code for erroricity and signal a reasonably ;;; informative condition if so. @@ -53,37 +54,19 @@ ;;; unless NULLS-OK is set. (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms) - (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms))) - `(let ((%lisp-oci-fn (uffi:def-function - (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn)))) - ,c-parms - :returning ,c-return))) - (defun ,lisp-oci-fn (,@ll &key database nulls-ok) - (let ((result (funcall %lisp-oci-fn ,@ll))) - (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))))))))) - + (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)) + (c-oci-fn (intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))) + `(progn + (declaim (inline ,c-oci-fn ,lisp-oci-fn)) + (uffi:def-function (,c-oci-symbol ,c-oci-fn) + ,c-parms + :returning ,c-return) + (defun ,lisp-oci-fn (,@ll &key database nulls-ok) + (let ((result (,c-oci-fn ,@ll))) + (if (= result #.+oci-success+) + +oci-success+ + (handle-oci-result result database nulls-ok))))))) + (defmacro def-raw-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms) @@ -110,7 +93,7 @@ (mode ub4) ; ub4 (xtramem-sz size_t) ; size_t (usermempp (* :pointer-void))) ; dvoid ** - + #-oci7 (def-oci-routine ("OCIEnvCreate" oci-env-create) :int @@ -150,11 +133,11 @@ (envhp :pointer-void) ; env (errhp :pointer-void) ; err (svchpp (* :pointer-void)) ; svc - (username :cstring) ; username + (username (* :unsigned-char)) ; username (uname-len ub4) ; - (passwd :cstring) ; passwd + (passwd (* :unsigned-char)) ; passwd (password-len ub4) ; - (dsn :cstring) ; datasource + (dsn (* :unsigned-char)) ; datasource (dsn-len ub4)) ; (def-oci-routine ("OCILogoff" oci-logoff) @@ -162,6 +145,7 @@ (p0 :pointer-void) ; svc (p1 :pointer-void)) ; err +(declaim (inline oci-error-get)) (uffi:def-function ("OCIErrorGet" oci-error-get) ((handlp :pointer-void) (recordno ub4) @@ -176,7 +160,7 @@ :int (stmtp :pointer-void) (errhp :pointer-void) - (stmt :cstring) + (stmt (* :unsigned-char)) (stmt_len ub4) (language ub4) (mode ub4)) @@ -226,10 +210,10 @@ (position ub4) (valuep :pointer-void) (value_sz sb4) - (dty ub2) + (dty ub2) (indp (* sb2)) - (rlenp (* ub2)) - (rcodep (* ub2)) + (rlenp (* ub2)) + (rcodep (* ub2)) (mode ub4)) (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch) @@ -290,7 +274,7 @@ :returning :int) -(uffi:def-function "OCIHandleAlloc" +(uffi:def-function "OCIHandleAlloc" ((parenth :pointer-void) ; const dvoid * (hndlpp (* :pointer-void)) ; dvoid ** (type ub4) ; ub4