X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-oracle%2Foracle-api.lisp;h=19b3f6e37f98d7861b3bfa9d9d9bcdc6d5323297;hp=96b8e168cd80a746235516cca884a43903f683e8;hb=ab37892bfa71e0d66021cc73f28cd189be30c81c;hpb=8e4ed03c227c7476acf9888d94fa6d1426989076 diff --git a/db-oracle/oracle-api.lisp b/db-oracle/oracle-api.lisp index 96b8e16..19b3f6e 100644 --- a/db-oracle/oracle-api.lisp +++ b/db-oracle/oracle-api.lisp @@ -16,66 +16,31 @@ (in-package #:clsql-oracle) -(defvar *oci-initialized* nil) - -(defvar *oci-env* nil) +;; +;; OCI integer types +;; +(uffi:def-foreign-type ub2 :unsigned-short) +(uffi:def-foreign-type sb2 :short) +(uffi:def-foreign-type ub4 :unsigned-int) +(uffi:def-foreign-type sb4 :int) +(uffi:def-foreign-type size_t :unsigned-long) ;; ;; Opaque pointer types ;; -(uffi:def-foreign-type oci-env (* :void)) - -(uffi:def-foreign-type oci-server (* :void)) - -(uffi:def-foreign-type oci-error (* :void)) - -(uffi:def-foreign-type oci-svc-ctx (* :void)) - -(uffi:def-foreign-type oci-stmt (* :void)) - - -(defvar *oci-handle-types* - '(:error ; error report handle (OCIError) - :service-context ; service context handle (OCISvcCtx) - :statement ; statement (application request) handle (OCIStmt) - :describe ; select list description handle (OCIDescribe) - :server ; server context handle (OCIServer) - :session ; user session handle (OCISession) - :transaction ; transaction context handle (OCITrans) - :complex-object ; complex object retrieval handle (OCIComplexObject) - :security)) ; security handle (OCISecurity) - -(defstruct oci-handle - (type :unknown) - (pointer (uffi:allocate-foreign-object '(* :void)))) +(uffi:def-foreign-type void-pointer :pointer-void) +(uffi:def-foreign-type oci-env :pointer-void) +(uffi:def-foreign-type oci-server :pointer-void) +(uffi:def-foreign-type oci-error :pointer-void) +(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 (* :void))) - -(uffi:def-function "OCIInitialize" - ((a :int) - (b (* :void)) - (c (* :void)) - (d (* :void)) - (e (* :void))) - :returning :int) - -(uffi:def-function "OCIEnvInit" - ((a (* :void)) - (b :int) - (c :int) - (d (* :void))) - :returning :int) - -(uffi:def-function "OCIHandleAlloc" - ((a :unsigned-int) - (b (* :void)) - (c :int) - (d :int) - (e (* :void))) - :returning :int) +(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. @@ -89,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) (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 "OCI No Data Found")) - (#.+oci-success-with-info+ - (error "internal error: unexpected +oci-SUCCESS-WITH-INFO")) - (#.+oci-no-data+ - (error "OCI No Data")) - (#.+oci-invalid-handle+ - (error "OCI Invalid Handle")) - (#.+oci-need-data+ - (error "OCI Need Data")) - (#.+oci-still-executing+ - (error "OCI Still Executing")) - (#.+oci-continue+ - (error "OCI Continue")) - (1804 - (error "Check ORACLE_HOME and NLS settings.")) - (t - (error "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) @@ -128,182 +75,239 @@ ,c-parms :returning ,c-return))) (defun ,lisp-oci-fn (,@ll &key database nulls-ok) + (declare (ignore database nulls-ok)) (funcall %lisp-oci-fn ,@ll))))) (def-oci-routine ("OCIInitialize" oci-initialize) :int - (mode :unsigned-long) ; ub4 - (ctxp (* :void)) ; dvoid * - (malocfp (* :void)) ; dvoid *(*) - (ralocfp (* :void)) ; dvoid *(*) - (mfreefp (* (* :void)))) ; void *(*) + (mode ub4) ; ub4 + (ctxp :pointer-void) ; dvoid * + (malocfp :pointer-void) ; dvoid *(*) + (ralocfp :pointer-void) ; dvoid *(*) + (mfreefp (* :pointer-void))) ; void *(*) (def-oci-routine ("OCIEnvInit" oci-env-init) :int - (envpp (* :void)) ; OCIEnv ** - (mode :unsigned-long) ; ub4 - (xtramem-sz :unsigned-long) ; size_t - (usermempp (* (* :void)))) ; dvoid ** - -#+oci-8-1-5 + (envpp :pointer-void) ; OCIEnv ** + (mode ub4) ; ub4 + (xtramem-sz size_t) ; size_t + (usermempp (* :pointer-void))) ; dvoid ** + +#-oci7 (def-oci-routine ("OCIEnvCreate" oci-env-create) :int - (p0 (* :void)) - (p1 :unsigned-int) - (p2 (* :void)) - (p3 (* :void)) - (p4 (* :void)) - (p5 (* :void)) - (p6 :unsigned-long) - (p7 (* :void))) + (envhpp (* :pointer-void)) + (mode ub4) + (ctxp :pointer-void) + (malocfp :pointer-void) + (ralocfp :pointer-void) + (mfreefp :pointer-void) + (xtramemsz size_t) + (usrmempp (* :pointer-void))) (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc) :int - (parenth (* :void)) ; const dvoid * - (hndlpp (* (* :void))) ; dvoid ** - (type :unsigned-long) ; ub4 - (xtramem_sz :unsigned-long) ; size_t - (usrmempp (* (* :void)))) ; dvoid ** + (parenth :pointer-void) ; const dvoid * + (hndlpp (* :pointer-void)) ; dvoid ** + (type ub4) ; ub4 + (xtramem_sz size_t) ; size_t + (usrmempp (* :pointer-void))) ; dvoid ** (def-oci-routine ("OCIServerAttach" oci-server-attach) :int - (srvhp (* :void)) ; oci-server - (errhp (* :void)) ; oci-error - (dblink :cstring) ; :in - (dblink-len :unsigned-long) ; int - (mode :unsigned-long)) ; int + (srvhp :pointer-void) ; oci-server + (errhp :pointer-void) ; oci-error + (dblink :cstring) ; :in + (dblink-len sb4) ; sb4 + (mode ub4)) ; ub4 (def-oci-routine ("OCIHandleFree" oci-handle-free) :int - (p0 (* :void)) ;; handle - (p1 :unsigned-long)) ;;type + (p0 :pointer-void) ;; handle + (p1 ub4)) ;;type (def-oci-routine ("OCILogon" oci-logon) :int - (envhp (* :void)) ; env - (errhp (* :void)) ; err - (svchpp (* (* :void))) ; svc - (username :cstring) ; username - (uname-len :unsigned-long) ; - (passwd :cstring) ; passwd - (password-len :unsigned-long) ; - (dsn :cstring) ; datasource - (dsn-len :unsigned-long)) ; + (envhp :pointer-void) ; env + (errhp :pointer-void) ; err + (svchpp (* :pointer-void)) ; svc + (username (* :unsigned-char)) ; username + (uname-len ub4) ; + (passwd (* :unsigned-char)) ; passwd + (password-len ub4) ; + (dsn (* :unsigned-char)) ; datasource + (dsn-len ub4)) ; (def-oci-routine ("OCILogoff" oci-logoff) :int - (p0 (* :void)) ; svc - (p1 (* :void))) ; err + (p0 :pointer-void) ; svc + (p1 :pointer-void)) ; err +(declaim (inline oci-error-get)) (uffi:def-function ("OCIErrorGet" oci-error-get) - ((handlp (* :void)) - (recordno :unsigned-long) - (sqlstate :cstring) - (errcodep (* :long)) + ((handlp :pointer-void) + (recordno ub4) + (sqlstate :cstring) + (errcodep (* sb4)) (bufp (* :unsigned-char)) - (bufsize :unsigned-long) - (type :unsigned-long)) + (bufsize ub4) + (type ub4)) :returning :void) (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare) :int - (stmtp (* :void)) - (errhp (* :void)) - (stmt :cstring) - (stmt_len :unsigned-long) - (language :unsigned-long) - (mode :unsigned-long)) + (stmtp :pointer-void) + (errhp :pointer-void) + (stmt (* :unsigned-char)) + (stmt_len ub4) + (language ub4) + (mode ub4)) (def-oci-routine ("OCIStmtExecute" oci-stmt-execute) :int - (svchp (* :void)) - (stmtp1 (* :void)) - (errhp (* :void)) - (iters :unsigned-long) - (rowoff :unsigned-long) - (snap_in (* :void)) - (snap_out (* :void)) - (mode :unsigned-long)) + (svchp :pointer-void) + (stmtp1 :pointer-void) + (errhp :pointer-void) + (iters ub4) + (rowoff ub4) + (snap_in :pointer-void) + (snap_out :pointer-void) + (mode ub4)) (def-raw-oci-routine ("OCIParamGet" oci-param-get) :int - (hndlp (* :void)) - (htype :unsigned-long) - (errhp (* :void)) - (parmdpp (* (* :void))) - (pos :unsigned-long)) + (hndlp :pointer-void) + (htype ub4) + (errhp :pointer-void) + (parmdpp (* :pointer-void)) + (pos ub4)) (def-oci-routine ("OCIAttrGet" oci-attr-get) :int - (trgthndlp (* :void)) - (trghndltyp :unsigned-int) - (attributep (* :void)) - (sizep (* :unsigned-int)) - (attrtype :unsigned-int) - (errhp (* :void))) + (trgthndlp :pointer-void) + (trghndltyp ub4) + (attributep :pointer-void) + (sizep (* ub4)) + (attrtype ub4) + (errhp :pointer-void)) (def-oci-routine ("OCIAttrSet" oci-attr-set) :int - (trgthndlp (* :void)) - (trgthndltyp :int :in) - (attributep (* :void)) - (size :int) - (attrtype :int) - (errhp oci-error)) + (trgthndlp :pointer-void) + (trgthndltyp ub4 :in) + (attributep :pointer-void) + (size ub4) + (attrtype ub4) + (errhp oci-error)) (def-oci-routine ("OCIDefineByPos" oci-define-by-pos) :int - (stmtp (* :void)) - (defnpp (* (* :void))) - (errhp (* :void)) - (position :unsigned-long) - (valuep (* :void)) - (value_sz :long) - (dty :unsigned-short) - (indp (* :void)) - (rlenp (* :unsigned-short)) - (rcodep (* :unsigned-short)) - (mode :unsigned-long)) + (stmtp :pointer-void) + (defnpp (* :pointer-void)) + (errhp :pointer-void) + (position ub4) + (valuep :pointer-void) + (value_sz sb4) + (dty ub2) + (indp (* sb2)) + (rlenp (* ub2)) + (rcodep (* ub2)) + (mode ub4)) (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch) :int - (stmthp (* :void)) - (errhp (* :void)) - (p2 :unsigned-long) - (p3 :unsigned-short) - (p4 :unsigned-long)) + (stmthp :pointer-void) + (errhp :pointer-void) + (p2 ub4) + (p3 ub2) + (p4 ub4)) (def-oci-routine ("OCITransStart" oci-trans-start) :int - (svchp (* :void)) - (errhp (* :void)) + (svchp :pointer-void) + (errhp :pointer-void) (p2 :unsigned-short) (p3 :unsigned-short)) (def-oci-routine ("OCITransCommit" oci-trans-commit) :int - (svchp (* :void)) - (errhp (* :void)) + (svchp :pointer-void) + (errhp :pointer-void) (p2 :unsigned-short)) (def-oci-routine ("OCITransRollback" oci-trans-rollback) :int - (svchp (* :void)) - (errhp (* :void)) + (svchp :pointer-void) + (errhp :pointer-void) (p2 :unsigned-short)) +(def-oci-routine ("OCIServerVersion" oci-server-version) + :int + (handlp :pointer-void) + (errhp :pointer-void) + (bufp (* :unsigned-char)) + (bufsz :int) + (hndltype :short)) + + + +;;; Low-level routines that don't do error checking. They are used +;;; for setting up global environment. + +(uffi:def-function "OCIInitialize" + ((mode ub4) ; ub4 + (ctxp :pointer-void) ; dvoid * + (malocfp :pointer-void) ; dvoid *(*) + (ralocfp :pointer-void) ; dvoid *(*) + (mfreefp (* :pointer-void))) + :returning :int) + +(uffi:def-function "OCIEnvInit" + ((envpp :pointer-void) ; OCIEnv ** + (mode ub4) ; ub4 + (xtramem-sz size_t) ; size_t + (usermempp (* :pointer-void))) + :returning :int) + + +(uffi:def-function "OCIHandleAlloc" + ((parenth :pointer-void) ; const dvoid * + (hndlpp (* :pointer-void)) ; dvoid ** + (type ub4) ; ub4 + (xtramem_sz size_t) ; size_t + (usrmempp (* :pointer-void))) + :returning :int) + +(defstruct oci-handle + (type :unknown) + (pointer (uffi:allocate-foreign-object :pointer-void))) + +(defvar *oci-initialized* nil) +(defvar *oci-env* nil) + +(defvar *oci-handle-types* + '(:error ; error report handle (OCIError) + :service-context ; service context handle (OCISvcCtx) + :statement ; statement (application request) handle (OCIStmt) + :describe ; select list description handle (OCIDescribe) + :server ; server context handle (OCIServer) + :session ; user session handle (OCISession) + :transaction ; transaction context handle (OCITrans) + :complex-object ; complex object retrieval handle (OCIComplexObject) + :security)) ; security handle (OCISecurity) + -;;; Functions (defun oci-init (&key (mode +oci-default+)) - (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+))) + (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ + +null-void-pointer+ +null-void-pointer-pointer+))) (if (= x 0) - (let ((env (uffi:make-pointer 0 oci-env))) + (let ((env (uffi:allocate-foreign-object :pointer-void))) (setq *oci-initialized* mode) (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+))) (format t ";; OEI: returned ~d~%" x) @@ -311,20 +315,20 @@ (defun oci-check-return (value) (when (= value +oci-invalid-handle+) - (error "Invalid Handle"))) + (error 'sql-database-error :message "Invalid Handle"))) (defun oci-get-handle (&key type) (if (null *oci-initialized*) (oci-init)) (case type (:error - (let ((ptr (uffi:make-null-pointer (* :void)))) + (let ((ptr (uffi:allocate-foreign-object :pointer-void))) (let ((x (OCIHandleAlloc - (uffi:pointer-address (uffi:deref-pointer *oci-env* oci-env)) + (uffi:deref-pointer *oci-env* void-pointer) ptr +oci-default+ 0 - +null-void-pointer+))) + +null-void-pointer-pointer+))) (oci-check-return x) ptr))) (:service-context @@ -344,7 +348,9 @@ (:security "OCISecurity") (t - (error "'~s' is not a valid OCI handle type" type)))) + (error 'sql-database-error + :message + (format nil "'~s' is not a valid OCI handle type" type))))) (defun oci-environment () (let ((envhp (oci-get-handle :type :env)))