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 'sql-database-error :message "OCI No Data Found"))
61 (#.+oci-success-with-info+
62 (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
64 (error 'sql-database-error :message "OCI No Data"))
65 (#.+oci-invalid-handle+
66 (error 'sql-database-error :message "OCI Invalid Handle"))
68 (error 'sql-database-error :message "OCI Need Data"))
69 (#.+oci-still-executing+
70 (error 'sql-temporary-error :message "OCI Still Executing"))
72 (error 'sql-database-error :message "OCI Continue"))
74 (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
76 (error 'sql-database-error
78 (format nil "OCI unknown error, code=~A" result)))))))))
81 (defmacro def-raw-oci-routine
82 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
83 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
84 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
86 :returning ,c-return)))
87 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
88 (funcall %lisp-oci-fn ,@ll)))))
91 (def-oci-routine ("OCIInitialize" oci-initialize)
93 (mode :unsigned-long) ; ub4
94 (ctxp :pointer-void) ; dvoid *
95 (malocfp :pointer-void) ; dvoid *(*)
96 (ralocfp :pointer-void) ; dvoid *(*)
97 (mfreefp (* :pointer-void))) ; void *(*)
100 (def-oci-routine ("OCIEnvInit" oci-env-init)
102 (envpp :pointer-void) ; OCIEnv **
103 (mode :unsigned-long) ; ub4
104 (xtramem-sz :unsigned-long) ; size_t
105 (usermempp (* :pointer-void))) ; dvoid **
108 (def-oci-routine ("OCIEnvCreate" oci-env-create)
119 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
121 (parenth :pointer-void) ; const dvoid *
122 (hndlpp (* :pointer-void)) ; dvoid **
123 (type :unsigned-long) ; ub4
124 (xtramem_sz :unsigned-long) ; size_t
125 (usrmempp (* :pointer-void))) ; dvoid **
127 (def-oci-routine ("OCIServerAttach" oci-server-attach)
129 (srvhp :pointer-void) ; oci-server
130 (errhp :pointer-void) ; oci-error
131 (dblink :cstring) ; :in
132 (dblink-len :unsigned-long) ; int
133 (mode :unsigned-long)) ; int
136 (def-oci-routine ("OCIHandleFree" oci-handle-free)
138 (p0 :pointer-void) ;; handle
139 (p1 :unsigned-long)) ;;type
141 (def-oci-routine ("OCILogon" oci-logon)
143 (envhp :pointer-void) ; env
144 (errhp :pointer-void) ; err
145 (svchpp (* :pointer-void)) ; svc
146 (username :cstring) ; username
147 (uname-len :unsigned-long) ;
148 (passwd :cstring) ; passwd
149 (password-len :unsigned-long) ;
150 (dsn :cstring) ; datasource
151 (dsn-len :unsigned-long)) ;
153 (def-oci-routine ("OCILogoff" oci-logoff)
155 (p0 :pointer-void) ; svc
156 (p1 :pointer-void)) ; err
158 (uffi:def-function ("OCIErrorGet" oci-error-get)
159 ((handlp :pointer-void)
160 (recordno :unsigned-long)
163 (bufp (* :unsigned-char))
164 (bufsize :unsigned-long)
165 (type :unsigned-long))
168 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
170 (stmtp :pointer-void)
171 (errhp :pointer-void)
173 (stmt_len :unsigned-long)
174 (language :unsigned-long)
175 (mode :unsigned-long))
177 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
179 (svchp :pointer-void)
180 (stmtp1 :pointer-void)
181 (errhp :pointer-void)
182 (iters :unsigned-long)
183 (rowoff :unsigned-long)
184 (snap_in :pointer-void)
185 (snap_out :pointer-void)
186 (mode :unsigned-long))
188 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
190 (hndlp :pointer-void)
191 (htype :unsigned-long)
192 (errhp :pointer-void)
193 (parmdpp (* :pointer-void))
194 (pos :unsigned-long))
196 (def-oci-routine ("OCIAttrGet" oci-attr-get)
198 (trgthndlp :pointer-void)
199 (trghndltyp :unsigned-int)
200 (attributep :pointer-void)
201 (sizep (* :unsigned-int))
202 (attrtype :unsigned-int)
203 (errhp :pointer-void))
205 (def-oci-routine ("OCIAttrSet" oci-attr-set)
207 (trgthndlp :pointer-void)
208 (trgthndltyp :int :in)
209 (attributep :pointer-void)
214 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
216 (stmtp :pointer-void)
217 (defnpp (* :pointer-void))
218 (errhp :pointer-void)
219 (position :unsigned-long)
220 (valuep :pointer-void)
222 (dty :unsigned-short)
224 (rlenp (* :unsigned-short))
225 (rcodep (* :unsigned-short))
226 (mode :unsigned-long))
228 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
230 (stmthp :pointer-void)
231 (errhp :pointer-void)
237 (def-oci-routine ("OCITransStart" oci-trans-start)
239 (svchp :pointer-void)
240 (errhp :pointer-void)
242 (p3 :unsigned-short))
244 (def-oci-routine ("OCITransCommit" oci-trans-commit)
246 (svchp :pointer-void)
247 (errhp :pointer-void)
248 (p2 :unsigned-short))
250 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
252 (svchp :pointer-void)
253 (errhp :pointer-void)
254 (p2 :unsigned-short))
257 (def-oci-routine ("OCIServerVersion" oci-server-version)
259 (handlp :pointer-void)
260 (errhp :pointer-void)
261 (bufp (* :unsigned-char))
267 ;;; Low-level routines that don't do error checking. They are used
268 ;;; for setting up global environment.
270 (uffi:def-function "OCIInitialize"
271 ((mode :unsigned-long) ; ub4
272 (ctxp :pointer-void) ; dvoid *
273 (malocfp :pointer-void) ; dvoid *(*)
274 (ralocfp :pointer-void) ; dvoid *(*)
275 (mfreefp (* :pointer-void)))
278 (uffi:def-function "OCIEnvInit"
279 ((envpp :pointer-void) ; OCIEnv **
280 (mode :unsigned-long) ; ub4
281 (xtramem-sz :unsigned-long) ; size_t
282 (usermempp (* :pointer-void)))
286 (uffi:def-function "OCIHandleAlloc"
287 ((parenth :pointer-void) ; const dvoid *
288 (hndlpp (* :pointer-void)) ; dvoid **
289 (type :unsigned-long) ; ub4
290 (xtramem_sz :unsigned-long) ; size_t
291 (usrmempp (* :pointer-void)))
294 (defstruct oci-handle
296 (pointer (uffi:allocate-foreign-object :pointer-void)))
298 (defvar *oci-initialized* nil)
299 (defvar *oci-env* nil)
301 (defvar *oci-handle-types*
302 '(:error ; error report handle (OCIError)
303 :service-context ; service context handle (OCISvcCtx)
304 :statement ; statement (application request) handle (OCIStmt)
305 :describe ; select list description handle (OCIDescribe)
306 :server ; server context handle (OCIServer)
307 :session ; user session handle (OCISession)
308 :transaction ; transaction context handle (OCITrans)
309 :complex-object ; complex object retrieval handle (OCIComplexObject)
310 :security)) ; security handle (OCISecurity)
314 (defun oci-init (&key (mode +oci-default+))
315 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
316 +null-void-pointer+ +null-void-pointer-pointer+)))
318 (let ((env (uffi:allocate-foreign-object :pointer-void)))
319 (setq *oci-initialized* mode)
320 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
321 (format t ";; OEI: returned ~d~%" x)
322 (setq *oci-env* env))))))
324 (defun oci-check-return (value)
325 (when (= value +oci-invalid-handle+)
326 (error 'sql-database-error :message "Invalid Handle")))
328 (defun oci-get-handle (&key type)
329 (if (null *oci-initialized*)
333 (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
334 (let ((x (OCIHandleAlloc
335 (uffi:deref-pointer *oci-env* void-pointer)
339 +null-void-pointer-pointer+)))
359 (error 'sql-database-error
361 (format nil "'~s' is not a valid OCI handle type" type)))))
363 (defun oci-environment ()
364 (let ((envhp (oci-get-handle :type :env)))
365 (oci-env-init envhp 0 0 +null-void-pointer+)