1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Package definition for CLSQL Oracle interface
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
17 (in-package #:clsql-oracle)
21 ;; Opaque pointer types
24 (uffi:def-foreign-type void-pointer :pointer-void)
25 (uffi:def-foreign-type oci-env :pointer-void)
26 (uffi:def-foreign-type oci-server :pointer-void)
27 (uffi:def-foreign-type oci-error :pointer-void)
28 (uffi:def-foreign-type oci-svc-ctx :pointer-void)
29 (uffi:def-foreign-type oci-stmt :pointer-void)
32 (defvar +null-void-pointer+ (uffi:make-null-pointer :void))
33 (defvar +null-void-pointer-pointer+ (uffi:make-null-pointer :pointer-void))
35 ;;; Check an OCI return code for erroricity and signal a reasonably
36 ;;; informative condition if so.
38 ;;; ERRHP provides an error handle which can be used to find
39 ;;; subconditions; if it's not provided, subcodes won't be checked.
41 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
42 ;;; normal and needn't cause any signal. An error handle is required
43 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
44 ;;; unless NULLS-OK is set.
46 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
47 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
48 `(let ((%lisp-oci-fn (uffi:def-function
49 (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
51 :returning ,c-return)))
52 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
53 (let ((result (funcall %lisp-oci-fn ,@ll)))
58 (handle-oci-error :database database :nulls-ok nulls-ok))
60 (error "OCI No Data Found"))
61 (#.+oci-success-with-info+
62 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
64 (error "OCI No Data"))
65 (#.+oci-invalid-handle+
66 (error "OCI Invalid Handle"))
68 (error "OCI Need Data"))
69 (#.+oci-still-executing+
70 (error "OCI Still Executing"))
72 (error "OCI Continue"))
74 (error "Check ORACLE_HOME and NLS settings."))
76 (error "OCI unknown error, code=~A" result))))))))
79 (defmacro def-raw-oci-routine
80 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
81 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
82 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
84 :returning ,c-return)))
85 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
86 (funcall %lisp-oci-fn ,@ll)))))
89 (def-oci-routine ("OCIInitialize" oci-initialize)
91 (mode :unsigned-long) ; ub4
92 (ctxp :pointer-void) ; dvoid *
93 (malocfp :pointer-void) ; dvoid *(*)
94 (ralocfp :pointer-void) ; dvoid *(*)
95 (mfreefp (* :pointer-void))) ; void *(*)
98 (def-oci-routine ("OCIEnvInit" oci-env-init)
100 (envpp :pointer-void) ; OCIEnv **
101 (mode :unsigned-long) ; ub4
102 (xtramem-sz :unsigned-long) ; size_t
103 (usermempp (* :pointer-void))) ; dvoid **
106 (def-oci-routine ("OCIEnvCreate" oci-env-create)
117 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
119 (parenth :pointer-void) ; const dvoid *
120 (hndlpp (* :pointer-void)) ; dvoid **
121 (type :unsigned-long) ; ub4
122 (xtramem_sz :unsigned-long) ; size_t
123 (usrmempp (* :pointer-void))) ; dvoid **
125 (def-oci-routine ("OCIServerAttach" oci-server-attach)
127 (srvhp :pointer-void) ; oci-server
128 (errhp :pointer-void) ; oci-error
129 (dblink :cstring) ; :in
130 (dblink-len :unsigned-long) ; int
131 (mode :unsigned-long)) ; int
134 (def-oci-routine ("OCIHandleFree" oci-handle-free)
136 (p0 :pointer-void) ;; handle
137 (p1 :unsigned-long)) ;;type
139 (def-oci-routine ("OCILogon" oci-logon)
141 (envhp :pointer-void) ; env
142 (errhp :pointer-void) ; err
143 (svchpp (* :pointer-void)) ; svc
144 (username :cstring) ; username
145 (uname-len :unsigned-long) ;
146 (passwd :cstring) ; passwd
147 (password-len :unsigned-long) ;
148 (dsn :cstring) ; datasource
149 (dsn-len :unsigned-long)) ;
151 (def-oci-routine ("OCILogoff" oci-logoff)
153 (p0 :pointer-void) ; svc
154 (p1 :pointer-void)) ; err
156 (uffi:def-function ("OCIErrorGet" oci-error-get)
157 ((handlp :pointer-void)
158 (recordno :unsigned-long)
161 (bufp (* :unsigned-char))
162 (bufsize :unsigned-long)
163 (type :unsigned-long))
166 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
168 (stmtp :pointer-void)
169 (errhp :pointer-void)
171 (stmt_len :unsigned-long)
172 (language :unsigned-long)
173 (mode :unsigned-long))
175 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
177 (svchp :pointer-void)
178 (stmtp1 :pointer-void)
179 (errhp :pointer-void)
180 (iters :unsigned-long)
181 (rowoff :unsigned-long)
182 (snap_in :pointer-void)
183 (snap_out :pointer-void)
184 (mode :unsigned-long))
186 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
188 (hndlp :pointer-void)
189 (htype :unsigned-long)
190 (errhp :pointer-void)
191 (parmdpp (* :pointer-void))
192 (pos :unsigned-long))
194 (def-oci-routine ("OCIAttrGet" oci-attr-get)
196 (trgthndlp :pointer-void)
197 (trghndltyp :unsigned-int)
198 (attributep :pointer-void)
199 (sizep (* :unsigned-int))
200 (attrtype :unsigned-int)
201 (errhp :pointer-void))
203 (def-oci-routine ("OCIAttrSet" oci-attr-set)
205 (trgthndlp :pointer-void)
206 (trgthndltyp :int :in)
207 (attributep :pointer-void)
212 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
214 (stmtp :pointer-void)
215 (defnpp (* :pointer-void))
216 (errhp :pointer-void)
217 (position :unsigned-long)
218 (valuep :pointer-void)
220 (dty :unsigned-short)
222 (rlenp (* :unsigned-short))
223 (rcodep (* :unsigned-short))
224 (mode :unsigned-long))
226 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
228 (stmthp :pointer-void)
229 (errhp :pointer-void)
235 (def-oci-routine ("OCITransStart" oci-trans-start)
237 (svchp :pointer-void)
238 (errhp :pointer-void)
240 (p3 :unsigned-short))
242 (def-oci-routine ("OCITransCommit" oci-trans-commit)
244 (svchp :pointer-void)
245 (errhp :pointer-void)
246 (p2 :unsigned-short))
248 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
250 (svchp :pointer-void)
251 (errhp :pointer-void)
252 (p2 :unsigned-short))
255 (def-oci-routine ("OCIServerVersion" oci-server-version)
257 (handlp :pointer-void)
258 (errhp :pointer-void)
259 (bufp (* :unsigned-char))
265 ;;; Low-level routines that don't do error checking. They are used
266 ;;; for setting up global environment.
268 (uffi:def-function "OCIInitialize"
269 ((mode :unsigned-long) ; ub4
270 (ctxp :pointer-void) ; dvoid *
271 (malocfp :pointer-void) ; dvoid *(*)
272 (ralocfp :pointer-void) ; dvoid *(*)
273 (mfreefp (* :pointer-void)))
276 (uffi:def-function "OCIEnvInit"
277 ((envpp :pointer-void) ; OCIEnv **
278 (mode :unsigned-long) ; ub4
279 (xtramem-sz :unsigned-long) ; size_t
280 (usermempp (* :pointer-void)))
284 (uffi:def-function "OCIHandleAlloc"
285 ((parenth :pointer-void) ; const dvoid *
286 (hndlpp (* :pointer-void)) ; dvoid **
287 (type :unsigned-long) ; ub4
288 (xtramem_sz :unsigned-long) ; size_t
289 (usrmempp (* :pointer-void)))
292 (defstruct oci-handle
294 (pointer (uffi:allocate-foreign-object :pointer-void)))
296 (defvar *oci-initialized* nil)
297 (defvar *oci-env* nil)
299 (defvar *oci-handle-types*
300 '(:error ; error report handle (OCIError)
301 :service-context ; service context handle (OCISvcCtx)
302 :statement ; statement (application request) handle (OCIStmt)
303 :describe ; select list description handle (OCIDescribe)
304 :server ; server context handle (OCIServer)
305 :session ; user session handle (OCISession)
306 :transaction ; transaction context handle (OCITrans)
307 :complex-object ; complex object retrieval handle (OCIComplexObject)
308 :security)) ; security handle (OCISecurity)
312 (defun oci-init (&key (mode +oci-default+))
313 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
314 +null-void-pointer+ +null-void-pointer-pointer+)))
316 (let ((env (uffi:allocate-foreign-object :pointer-void)))
317 (setq *oci-initialized* mode)
318 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
319 (format t ";; OEI: returned ~d~%" x)
320 (setq *oci-env* env))))))
322 (defun oci-check-return (value)
323 (when (= value +oci-invalid-handle+)
324 (error "Invalid Handle")))
326 (defun oci-get-handle (&key type)
327 (if (null *oci-initialized*)
331 (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
332 (let ((x (OCIHandleAlloc
333 (uffi:deref-pointer *oci-env* void-pointer)
337 +null-void-pointer-pointer+)))
357 (error "'~s' is not a valid OCI handle type" type))))
359 (defun oci-environment ()
360 (let ((envhp (oci-get-handle :type :env)))
361 (oci-env-init envhp 0 0 +null-void-pointer+)