1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Package definition for CLSQL Oracle interface
8 ;;;; This file is part of CLSQL.
10 ;;;; CLSQL users are granted the rights to distribute and use this software
11 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
12 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
13 ;;;; *************************************************************************
15 (in-package #:clsql-oracle)
21 (uffi:def-foreign-type ub2 :unsigned-short)
22 (uffi:def-foreign-type sb2 :short)
23 (uffi:def-foreign-type ub4 :unsigned-int)
24 (uffi:def-foreign-type sb4 :int)
25 (uffi:def-foreign-type size_t :unsigned-long)
28 ;; Opaque pointer types
31 (uffi:def-foreign-type void-pointer :pointer-void)
32 (uffi:def-foreign-type oci-env :pointer-void)
33 (uffi:def-foreign-type oci-server :pointer-void)
34 (uffi:def-foreign-type oci-error :pointer-void)
35 (uffi:def-foreign-type oci-svc-ctx :pointer-void)
36 (uffi:def-foreign-type oci-stmt :pointer-void)
38 (uffi:def-pointer-var +null-void-pointer+
39 (uffi:make-null-pointer :void))
40 (uffi:def-pointer-var +null-void-pointer-pointer+
41 (uffi:make-null-pointer :pointer-void))
43 ;;; Check an OCI return code for erroricity and signal a reasonably
44 ;;; informative condition if so.
46 ;;; ERRHP provides an error handle which can be used to find
47 ;;; subconditions; if it's not provided, subcodes won't be checked.
49 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
50 ;;; normal and needn't cause any signal. An error handle is required
51 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
52 ;;; unless NULLS-OK is set.
54 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
55 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms))
56 (c-oci-fn (intern (concatenate 'string "%" (symbol-name lisp-oci-fn)))))
58 (declaim (inline ,c-oci-fn ,lisp-oci-fn))
59 (uffi:def-function (,c-oci-symbol ,c-oci-fn)
62 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
63 (let ((result (,c-oci-fn ,@ll)))
64 (if (= result #.+oci-success+)
66 (handle-oci-result result database nulls-ok)))))))
69 (defmacro def-raw-oci-routine
70 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
71 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
72 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
74 :returning ,c-return)))
75 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
76 (declare (ignore database nulls-ok))
77 (funcall %lisp-oci-fn ,@ll)))))
80 (def-oci-routine ("OCIInitialize" oci-initialize)
83 (ctxp :pointer-void) ; dvoid *
84 (malocfp :pointer-void) ; dvoid *(*)
85 (ralocfp :pointer-void) ; dvoid *(*)
86 (mfreefp (* :pointer-void))) ; void *(*)
89 (def-oci-routine ("OCIEnvInit" oci-env-init)
91 (envpp :pointer-void) ; OCIEnv **
93 (xtramem-sz size_t) ; size_t
94 (usermempp (* :pointer-void))) ; dvoid **
97 (def-oci-routine ("OCIEnvCreate" oci-env-create)
99 (envhpp (* :pointer-void))
102 (malocfp :pointer-void)
103 (ralocfp :pointer-void)
104 (mfreefp :pointer-void)
106 (usrmempp (* :pointer-void)))
108 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
110 (parenth :pointer-void) ; const dvoid *
111 (hndlpp (* :pointer-void)) ; dvoid **
113 (xtramem_sz size_t) ; size_t
114 (usrmempp (* :pointer-void))) ; dvoid **
116 (def-oci-routine ("OCIServerAttach" oci-server-attach)
118 (srvhp :pointer-void) ; oci-server
119 (errhp :pointer-void) ; oci-error
120 (dblink :cstring) ; :in
121 (dblink-len sb4) ; sb4
125 (def-oci-routine ("OCIHandleFree" oci-handle-free)
127 (p0 :pointer-void) ;; handle
130 (def-oci-routine ("OCILogon" oci-logon)
132 (envhp :pointer-void) ; env
133 (errhp :pointer-void) ; err
134 (svchpp (* :pointer-void)) ; svc
135 (username (* :unsigned-char)) ; username
137 (passwd (* :unsigned-char)) ; passwd
139 (dsn (* :unsigned-char)) ; datasource
142 (def-oci-routine ("OCILogoff" oci-logoff)
144 (p0 :pointer-void) ; svc
145 (p1 :pointer-void)) ; err
147 (declaim (inline oci-error-get))
148 (uffi:def-function ("OCIErrorGet" oci-error-get)
149 ((handlp :pointer-void)
153 (bufp (* :unsigned-char))
158 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
160 (stmtp :pointer-void)
161 (errhp :pointer-void)
162 (stmt (* :unsigned-char))
167 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
169 (svchp :pointer-void)
170 (stmtp1 :pointer-void)
171 (errhp :pointer-void)
174 (snap_in :pointer-void)
175 (snap_out :pointer-void)
178 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
180 (hndlp :pointer-void)
182 (errhp :pointer-void)
183 (parmdpp (* :pointer-void))
186 (def-oci-routine ("OCIAttrGet" oci-attr-get)
188 (trgthndlp :pointer-void)
190 (attributep :pointer-void)
193 (errhp :pointer-void))
195 (def-oci-routine ("OCIAttrSet" oci-attr-set)
197 (trgthndlp :pointer-void)
198 (trgthndltyp ub4 :in)
199 (attributep :pointer-void)
204 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
206 (stmtp :pointer-void)
207 (defnpp (* :pointer-void))
208 (errhp :pointer-void)
210 (valuep :pointer-void)
218 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
220 (stmthp :pointer-void)
221 (errhp :pointer-void)
227 (def-oci-routine ("OCITransStart" oci-trans-start)
229 (svchp :pointer-void)
230 (errhp :pointer-void)
232 (p3 :unsigned-short))
234 (def-oci-routine ("OCITransCommit" oci-trans-commit)
236 (svchp :pointer-void)
237 (errhp :pointer-void)
238 (p2 :unsigned-short))
240 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
242 (svchp :pointer-void)
243 (errhp :pointer-void)
244 (p2 :unsigned-short))
247 (def-oci-routine ("OCIServerVersion" oci-server-version)
249 (handlp :pointer-void)
250 (errhp :pointer-void)
251 (bufp (* :unsigned-char))
257 ;;; Low-level routines that don't do error checking. They are used
258 ;;; for setting up global environment.
260 (uffi:def-function "OCIInitialize"
262 (ctxp :pointer-void) ; dvoid *
263 (malocfp :pointer-void) ; dvoid *(*)
264 (ralocfp :pointer-void) ; dvoid *(*)
265 (mfreefp (* :pointer-void)))
268 (uffi:def-function "OCIEnvInit"
269 ((envpp :pointer-void) ; OCIEnv **
271 (xtramem-sz size_t) ; size_t
272 (usermempp (* :pointer-void)))
276 (uffi:def-function "OCIHandleAlloc"
277 ((parenth :pointer-void) ; const dvoid *
278 (hndlpp (* :pointer-void)) ; dvoid **
280 (xtramem_sz size_t) ; size_t
281 (usrmempp (* :pointer-void)))
284 (defstruct oci-handle
286 (pointer (uffi:allocate-foreign-object :pointer-void)))
288 (defvar *oci-initialized* nil)
289 (defvar *oci-env* nil)
291 (defvar *oci-handle-types*
292 '(:error ; error report handle (OCIError)
293 :service-context ; service context handle (OCISvcCtx)
294 :statement ; statement (application request) handle (OCIStmt)
295 :describe ; select list description handle (OCIDescribe)
296 :server ; server context handle (OCIServer)
297 :session ; user session handle (OCISession)
298 :transaction ; transaction context handle (OCITrans)
299 :complex-object ; complex object retrieval handle (OCIComplexObject)
300 :security)) ; security handle (OCISecurity)
304 (defun oci-init (&key (mode +oci-default+))
305 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
306 +null-void-pointer+ +null-void-pointer-pointer+)))
308 (let ((env (uffi:allocate-foreign-object :pointer-void)))
309 (setq *oci-initialized* mode)
310 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
311 (format t ";; OEI: returned ~d~%" x)
312 (setq *oci-env* env))))))
314 (defun oci-check-return (value)
315 (when (= value +oci-invalid-handle+)
316 (error 'sql-database-error :message "Invalid Handle")))
318 (defun oci-get-handle (&key type)
319 (if (null *oci-initialized*)
323 (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
324 (let ((x (OCIHandleAlloc
325 (uffi:deref-pointer *oci-env* void-pointer)
329 +null-void-pointer-pointer+)))
349 (error 'sql-database-error
351 (format nil "'~s' is not a valid OCI handle type" type)))))
353 (defun oci-environment ()
354 (let ((envhp (oci-get-handle :type :env)))
355 (oci-env-init envhp 0 0 +null-void-pointer+)