2 ;;; $Id: oracle.cl,v 1.1 2002/09/18 07:43:41 kevin Exp $
4 ;;; MaiSQL --- Common Lisp Interface Layer to SQL Databases
5 ;;; This is copyrighted software. See documentation for terms.
7 ;;; oracle.lisp --- FFI interface to Oracle on Unix
9 ;;; The present content of this file is orented specifically towards
10 ;;; Oracle 8.0.5.1 under Linux, linking against libclntsh.so
12 (in-package :clsql-oracle)
16 (defvar *oci-initialized* nil)
18 (defvar *oci-env* nil)
22 ;; Opaque pointer types
25 (def-alien-type oci-env (* t))
27 (def-alien-type oci-server (* t))
29 (def-alien-type oci-error (* t))
31 (def-alien-type oci-svc-ctx (* t))
33 (def-alien-type oci-stmt (* t))
36 (defvar *oci-handle-types*
37 '(:error ; error report handle (OCIError)
38 :service-context ; service context handle (OCISvcCtx)
39 :statement ; statement (application request) handle (OCIStmt)
40 :describe ; select list description handle (OCIDescribe)
41 :server ; server context handle (OCIServer)
42 :session ; user session handle (OCISession)
43 :transaction ; transaction context handle (OCITrans)
44 :complex-object ; complex object retrieval handle (OCIComplexObject)
45 :security)) ; security handle (OCISecurity)
49 (pointer (make-alien (* t))))
51 (defun oci-init (&key (mode +oci-default+))
52 (let ((x (alien-funcall (extern-alien "OCIInitialize" (function int int (* t) (* t) (* t) (* t)))
53 mode nil nil nil nil)))
55 (let ((env (make-alien oci-env)))
56 (setq *oci-initialized* mode)
57 (let ((x (alien-funcall (extern-alien "OCIEnvInit" (function int (* t) int int (* t)))
58 env +oci-default+ 0 nil)))
59 (format t ";; OEI: reutrned ~d~%" x)
60 (setq *oci-env* env))))))
62 (defun oci-check-return (value)
63 (if (= value +oci-invalid-handle+)
64 (error "Invalid Handle")))
66 (defun oci-get-handle (&key type)
67 (if (null *oci-initialized*)
71 (let ((ptr (make-alien (* t))))
72 (let ((x (alien-funcall (extern-alien "OCIHandleAlloc" (function int unsigned-int (* t) int int (* t)))
73 (sap-ref-32 (alien-sap (deref *oci-env*)) 0)
97 (error "'~s' is not a valid OCI handle type" type))))
99 (defun oci-environment ()
100 (let ((envhp (oci-handle-alloc :type :env)))
104 ;;; Check an OCI return code for erroricity and signal a reasonably
105 ;;; informative condition if so.
107 ;;; ERRHP provides an error handle which can be used to find
108 ;;; subconditions; if it's not provided, subcodes won't be checked.
110 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
111 ;;; normal and needn't cause any signal. An error handle is required
112 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
113 ;;; unless NULLS-OK is set.
115 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
116 (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
117 `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
118 ,c-return ,@c-parms)))
119 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
120 (case (funcall %lisp-oci-fn ,@ll)
124 (handle-oci-error :database database :nulls-ok nulls-ok))
126 (error "OCI No Data Found"))
127 (#.+oci-success-with-info+
128 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
130 (error "OCI No Data"))
131 (#.+oci-invalid-handle+
132 (error "OCI Invalid Handle"))
134 (error "OCI Need Data"))
135 (#.+oci-still-executing+
136 (error "OCI Still Executing"))
138 (error "OCI Continue"))
140 (error "OCI unknown error, code=~A" (values))))))))
143 (defmacro def-raw-oci-routine
144 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
145 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
146 `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
147 ,c-return ,@c-parms)))
148 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
149 (funcall %lisp-oci-fn ,@ll)))))
152 (def-oci-routine ("OCIInitialize" OCI-INITIALIZE)
154 (mode unsigned-long) ; ub4
155 (ctxp (* t)) ; dvoid *
156 (malocfp (* t)) ; dvoid *(*)
157 (ralocfp (* t)) ; dvoid *(*)
158 (mfreefp (* t))) ; void *(*)
161 (def-oci-routine ("OCIEnvInit" OCI-ENV-INIT)
163 (envpp (* t)) ; OCIEnv **
164 (mode unsigned-long) ; ub4
165 (xtramem-sz unsigned-long) ; size_t
166 (usermempp (* t))) ; dvoid **
169 (def-oci-routine ("OCIEnvCreate" OCI-ENV-CREATE)
180 (def-oci-routine ("OCIHandleAlloc" OCI-HANDLE-ALLOC)
182 (parenth (* t)) ; const dvoid *
183 (hndlpp (* t)) ; dvoid **
184 (type unsigned-long) ; ub4
185 (xtramem_sz unsigned-long) ; size_t
186 (usrmempp (* t))) ; dvoid **
188 (def-oci-routine ("OCIServerAttach" OCI-SERVER-ATTACH)
190 (srvhp (* t)) ; oci-server
191 (errhp (* t)) ; oci-error
192 (dblink c-string) ; :in
193 (dblink-len unsigned-long) ; int
194 (mode unsigned-long)) ; int
197 (def-oci-routine ("OCIHandleFree" OCI-HANDLE-FREE)
200 (p1 unsigned-long)) ;;type
202 (def-oci-routine ("OCILogon" OCI-LOGON)
207 (username c-string) ; username
208 (uname-len unsigned-long) ;
209 (passwd c-string) ; passwd
210 (password-len unsigned-long) ;
211 (dsn c-string) ; datasource
212 (dsn-len unsigned-long)) ;
214 (def-oci-routine ("OCILogoff" OCI-LOGOFF)
219 (def-alien-routine ("OCIErrorGet" OCI-ERROR-GET)
229 (def-oci-routine ("OCIStmtPrepare" OCI-STMT-PREPARE)
238 (def-oci-routine ("OCIStmtExecute" OCI-STMT-EXECUTE)
249 (def-raw-oci-routine ("OCIParamGet" OCI-PARAM-GET)
257 (def-oci-routine ("OCIAttrGet" OCI-ATTR-GET)
262 (p3 (* unsigned-long))
267 (def-oci-routine ("OCIAttrSet" OCI-ATTR-SET)
270 (trgthndltyp int :in)
276 (def-oci-routine ("OCIDefineByPos" OCI-DEFINE-BY-POS)
290 (def-oci-routine ("OCIStmtFetch" OCI-STMT-FETCH)
299 (def-oci-routine ("OCITransStart" OCI-TRANS-START)
306 (def-oci-routine ("OCITransCommit" OCI-TRANS-COMMIT)
312 (def-oci-routine ("OCITransRollback" OCI-TRANS-ROLLBACK)