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)
23 (uffi:def-foreign-type ub2 :unsigned-short)
24 (uffi:def-foreign-type sb2 :short)
25 (uffi:def-foreign-type ub4 :unsigned-int)
26 (uffi:def-foreign-type sb4 :int)
27 (uffi:def-foreign-type size_t :unsigned-long)
30 ;; Opaque pointer types
33 (uffi:def-foreign-type void-pointer :pointer-void)
34 (uffi:def-foreign-type oci-env :pointer-void)
35 (uffi:def-foreign-type oci-server :pointer-void)
36 (uffi:def-foreign-type oci-error :pointer-void)
37 (uffi:def-foreign-type oci-svc-ctx :pointer-void)
38 (uffi:def-foreign-type oci-stmt :pointer-void)
41 (defvar +null-void-pointer+ (uffi:make-null-pointer :void))
42 (defvar +null-void-pointer-pointer+ (uffi:make-null-pointer :pointer-void))
44 ;;; Check an OCI return code for erroricity and signal a reasonably
45 ;;; informative condition if so.
47 ;;; ERRHP provides an error handle which can be used to find
48 ;;; subconditions; if it's not provided, subcodes won't be checked.
50 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
51 ;;; normal and needn't cause any signal. An error handle is required
52 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
53 ;;; unless NULLS-OK is set.
55 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
56 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
57 `(let ((%lisp-oci-fn (uffi:def-function
58 (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
60 :returning ,c-return)))
61 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
62 (let ((result (funcall %lisp-oci-fn ,@ll)))
67 (handle-oci-error :database database :nulls-ok nulls-ok))
69 (error 'sql-database-error :message "OCI No Data Found"))
70 (#.+oci-success-with-info+
71 (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
72 (#.+oci-invalid-handle+
73 (error 'sql-database-error :message "OCI Invalid Handle"))
75 (error 'sql-database-error :message "OCI Need Data"))
76 (#.+oci-still-executing+
77 (error 'sql-temporary-error :message "OCI Still Executing"))
79 (error 'sql-database-error :message "OCI Continue"))
81 (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
83 (error 'sql-database-error
85 (format nil "OCI unknown error, code=~A" result)))))))))
88 (defmacro def-raw-oci-routine
89 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
90 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
91 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
93 :returning ,c-return)))
94 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
95 (funcall %lisp-oci-fn ,@ll)))))
98 (def-oci-routine ("OCIInitialize" oci-initialize)
101 (ctxp :pointer-void) ; dvoid *
102 (malocfp :pointer-void) ; dvoid *(*)
103 (ralocfp :pointer-void) ; dvoid *(*)
104 (mfreefp (* :pointer-void))) ; void *(*)
107 (def-oci-routine ("OCIEnvInit" oci-env-init)
109 (envpp :pointer-void) ; OCIEnv **
111 (xtramem-sz size_t) ; size_t
112 (usermempp (* :pointer-void))) ; dvoid **
115 (def-oci-routine ("OCIEnvCreate" oci-env-create)
117 (envhpp (* :pointer-void))
120 (malocfp :pointer-void)
121 (ralocfp :pointer-void)
122 (mfreefp :pointer-void)
124 (usrmempp (* :pointer-void)))
126 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
128 (parenth :pointer-void) ; const dvoid *
129 (hndlpp (* :pointer-void)) ; dvoid **
131 (xtramem_sz size_t) ; size_t
132 (usrmempp (* :pointer-void))) ; dvoid **
134 (def-oci-routine ("OCIServerAttach" oci-server-attach)
136 (srvhp :pointer-void) ; oci-server
137 (errhp :pointer-void) ; oci-error
138 (dblink :cstring) ; :in
139 (dblink-len sb4) ; sb4
143 (def-oci-routine ("OCIHandleFree" oci-handle-free)
145 (p0 :pointer-void) ;; handle
148 (def-oci-routine ("OCILogon" oci-logon)
150 (envhp :pointer-void) ; env
151 (errhp :pointer-void) ; err
152 (svchpp (* :pointer-void)) ; svc
153 (username :cstring) ; username
155 (passwd :cstring) ; passwd
157 (dsn :cstring) ; datasource
160 (def-oci-routine ("OCILogoff" oci-logoff)
162 (p0 :pointer-void) ; svc
163 (p1 :pointer-void)) ; err
165 (uffi:def-function ("OCIErrorGet" oci-error-get)
166 ((handlp :pointer-void)
170 (bufp (* :unsigned-char))
175 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
177 (stmtp :pointer-void)
178 (errhp :pointer-void)
184 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
186 (svchp :pointer-void)
187 (stmtp1 :pointer-void)
188 (errhp :pointer-void)
191 (snap_in :pointer-void)
192 (snap_out :pointer-void)
195 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
197 (hndlp :pointer-void)
199 (errhp :pointer-void)
200 (parmdpp (* :pointer-void))
203 (def-oci-routine ("OCIAttrGet" oci-attr-get)
205 (trgthndlp :pointer-void)
207 (attributep :pointer-void)
210 (errhp :pointer-void))
212 (def-oci-routine ("OCIAttrSet" oci-attr-set)
214 (trgthndlp :pointer-void)
215 (trgthndltyp ub4 :in)
216 (attributep :pointer-void)
221 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
223 (stmtp :pointer-void)
224 (defnpp (* :pointer-void))
225 (errhp :pointer-void)
227 (valuep :pointer-void)
235 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
237 (stmthp :pointer-void)
238 (errhp :pointer-void)
244 (def-oci-routine ("OCITransStart" oci-trans-start)
246 (svchp :pointer-void)
247 (errhp :pointer-void)
249 (p3 :unsigned-short))
251 (def-oci-routine ("OCITransCommit" oci-trans-commit)
253 (svchp :pointer-void)
254 (errhp :pointer-void)
255 (p2 :unsigned-short))
257 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
259 (svchp :pointer-void)
260 (errhp :pointer-void)
261 (p2 :unsigned-short))
264 (def-oci-routine ("OCIServerVersion" oci-server-version)
266 (handlp :pointer-void)
267 (errhp :pointer-void)
268 (bufp (* :unsigned-char))
274 ;;; Low-level routines that don't do error checking. They are used
275 ;;; for setting up global environment.
277 (uffi:def-function "OCIInitialize"
279 (ctxp :pointer-void) ; dvoid *
280 (malocfp :pointer-void) ; dvoid *(*)
281 (ralocfp :pointer-void) ; dvoid *(*)
282 (mfreefp (* :pointer-void)))
285 (uffi:def-function "OCIEnvInit"
286 ((envpp :pointer-void) ; OCIEnv **
288 (xtramem-sz size_t) ; size_t
289 (usermempp (* :pointer-void)))
293 (uffi:def-function "OCIHandleAlloc"
294 ((parenth :pointer-void) ; const dvoid *
295 (hndlpp (* :pointer-void)) ; dvoid **
297 (xtramem_sz size_t) ; size_t
298 (usrmempp (* :pointer-void)))
301 (defstruct oci-handle
303 (pointer (uffi:allocate-foreign-object :pointer-void)))
305 (defvar *oci-initialized* nil)
306 (defvar *oci-env* nil)
308 (defvar *oci-handle-types*
309 '(:error ; error report handle (OCIError)
310 :service-context ; service context handle (OCISvcCtx)
311 :statement ; statement (application request) handle (OCIStmt)
312 :describe ; select list description handle (OCIDescribe)
313 :server ; server context handle (OCIServer)
314 :session ; user session handle (OCISession)
315 :transaction ; transaction context handle (OCITrans)
316 :complex-object ; complex object retrieval handle (OCIComplexObject)
317 :security)) ; security handle (OCISecurity)
321 (defun oci-init (&key (mode +oci-default+))
322 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
323 +null-void-pointer+ +null-void-pointer-pointer+)))
325 (let ((env (uffi:allocate-foreign-object :pointer-void)))
326 (setq *oci-initialized* mode)
327 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
328 (format t ";; OEI: returned ~d~%" x)
329 (setq *oci-env* env))))))
331 (defun oci-check-return (value)
332 (when (= value +oci-invalid-handle+)
333 (error 'sql-database-error :message "Invalid Handle")))
335 (defun oci-get-handle (&key type)
336 (if (null *oci-initialized*)
340 (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
341 (let ((x (OCIHandleAlloc
342 (uffi:deref-pointer *oci-env* void-pointer)
346 +null-void-pointer-pointer+)))
366 (error 'sql-database-error
368 (format nil "'~s' is not a valid OCI handle type" type)))))
370 (defun oci-environment ()
371 (let ((envhp (oci-get-handle :type :env)))
372 (oci-env-init envhp 0 0 +null-void-pointer+)