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)
19 (defvar *oci-initialized* nil)
21 (defvar *oci-env* nil)
25 ;; Opaque pointer types
28 (uffi:def-foreign-type oci-env (* :void))
30 (uffi:def-foreign-type oci-server (* :void))
32 (uffi:def-foreign-type oci-error (* :void))
34 (uffi:def-foreign-type oci-svc-ctx (* :void))
36 (uffi:def-foreign-type oci-stmt (* :void))
39 (defvar *oci-handle-types*
40 '(:error ; error report handle (OCIError)
41 :service-context ; service context handle (OCISvcCtx)
42 :statement ; statement (application request) handle (OCIStmt)
43 :describe ; select list description handle (OCIDescribe)
44 :server ; server context handle (OCIServer)
45 :session ; user session handle (OCISession)
46 :transaction ; transaction context handle (OCITrans)
47 :complex-object ; complex object retrieval handle (OCIComplexObject)
48 :security)) ; security handle (OCISecurity)
52 (pointer (uffi:allocate-foreign-object '(* :void))))
54 (defvar +null-void-pointer+ (uffi:make-null-pointer :void))
55 (defvar +null-void-pointer-pointer+ (uffi:make-null-pointer (* :void)))
57 (uffi:def-function "OCIInitialize"
65 (uffi:def-function "OCIEnvInit"
72 (uffi:def-function "OCIHandleAlloc"
80 ;;; Check an OCI return code for erroricity and signal a reasonably
81 ;;; informative condition if so.
83 ;;; ERRHP provides an error handle which can be used to find
84 ;;; subconditions; if it's not provided, subcodes won't be checked.
86 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
87 ;;; normal and needn't cause any signal. An error handle is required
88 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
89 ;;; unless NULLS-OK is set.
91 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
92 (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
93 `(let ((%lisp-oci-fn (uffi:def-function
94 (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
96 :returning ,c-return)))
97 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
98 (let ((result (funcall %lisp-oci-fn ,@ll)))
103 (handle-oci-error :database database :nulls-ok nulls-ok))
105 (error "OCI No Data Found"))
106 (#.+oci-success-with-info+
107 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
109 (error "OCI No Data"))
110 (#.+oci-invalid-handle+
111 (error "OCI Invalid Handle"))
113 (error "OCI Need Data"))
114 (#.+oci-still-executing+
115 (error "OCI Still Executing"))
117 (error "OCI Continue"))
119 (error "Check ORACLE_HOME and NLS settings."))
121 (error "OCI unknown error, code=~A" result))))))))
124 (defmacro def-raw-oci-routine
125 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
126 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
127 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
129 :returning ,c-return)))
130 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
131 (funcall %lisp-oci-fn ,@ll)))))
134 (def-oci-routine ("OCIInitialize" oci-initialize)
136 (mode :unsigned-long) ; ub4
137 (ctxp (* :void)) ; dvoid *
138 (malocfp (* :void)) ; dvoid *(*)
139 (ralocfp (* :void)) ; dvoid *(*)
140 (mfreefp (* (* :void)))) ; void *(*)
143 (def-oci-routine ("OCIEnvInit" oci-env-init)
145 (envpp (* :void)) ; OCIEnv **
146 (mode :unsigned-long) ; ub4
147 (xtramem-sz :unsigned-long) ; size_t
148 (usermempp (* (* :void)))) ; dvoid **
151 (def-oci-routine ("OCIEnvCreate" oci-env-create)
162 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
164 (parenth (* :void)) ; const dvoid *
165 (hndlpp (* (* :void))) ; dvoid **
166 (type :unsigned-long) ; ub4
167 (xtramem_sz :unsigned-long) ; size_t
168 (usrmempp (* (* :void)))) ; dvoid **
170 (def-oci-routine ("OCIServerAttach" oci-server-attach)
172 (srvhp (* :void)) ; oci-server
173 (errhp (* :void)) ; oci-error
174 (dblink :cstring) ; :in
175 (dblink-len :unsigned-long) ; int
176 (mode :unsigned-long)) ; int
179 (def-oci-routine ("OCIHandleFree" oci-handle-free)
181 (p0 (* :void)) ;; handle
182 (p1 :unsigned-long)) ;;type
184 (def-oci-routine ("OCILogon" oci-logon)
186 (envhp (* :void)) ; env
187 (errhp (* :void)) ; err
188 (svchpp (* (* :void))) ; svc
189 (username :cstring) ; username
190 (uname-len :unsigned-long) ;
191 (passwd :cstring) ; passwd
192 (password-len :unsigned-long) ;
193 (dsn :cstring) ; datasource
194 (dsn-len :unsigned-long)) ;
196 (def-oci-routine ("OCILogoff" oci-logoff)
199 (p1 (* :void))) ; err
201 (uffi:def-function ("OCIErrorGet" oci-error-get)
203 (recordno :unsigned-long)
206 (bufp (* :unsigned-char))
207 (bufsize :unsigned-long)
208 (type :unsigned-long))
211 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
216 (stmt_len :unsigned-long)
217 (language :unsigned-long)
218 (mode :unsigned-long))
220 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
225 (iters :unsigned-long)
226 (rowoff :unsigned-long)
229 (mode :unsigned-long))
231 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
234 (htype :unsigned-long)
236 (parmdpp (* (* :void)))
237 (pos :unsigned-long))
239 (def-oci-routine ("OCIAttrGet" oci-attr-get)
241 (trgthndlp (* :void))
242 (trghndltyp :unsigned-int)
243 (attributep (* :void))
244 (sizep (* :unsigned-int))
245 (attrtype :unsigned-int)
248 (def-oci-routine ("OCIAttrSet" oci-attr-set)
250 (trgthndlp (* :void))
251 (trgthndltyp :int :in)
252 (attributep (* :void))
257 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
260 (defnpp (* (* :void)))
262 (position :unsigned-long)
265 (dty :unsigned-short)
267 (rlenp (* :unsigned-short))
268 (rcodep (* :unsigned-short))
269 (mode :unsigned-long))
271 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
280 (def-oci-routine ("OCITransStart" oci-trans-start)
285 (p3 :unsigned-short))
287 (def-oci-routine ("OCITransCommit" oci-trans-commit)
291 (p2 :unsigned-short))
293 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
297 (p2 :unsigned-short))
300 (def-oci-routine ("OCIServerVersion" oci-server-version)
304 (bufp (* :unsigned-char))
311 (defun oci-init (&key (mode +oci-default+))
312 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+)))
314 (let ((env (uffi:make-pointer 0 oci-env)))
315 (setq *oci-initialized* mode)
316 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
317 (format t ";; OEI: returned ~d~%" x)
318 (setq *oci-env* env))))))
320 (defun oci-check-return (value)
321 (when (= value +oci-invalid-handle+)
322 (error "Invalid Handle")))
324 (defun oci-get-handle (&key type)
325 (if (null *oci-initialized*)
329 (let ((ptr (uffi:make-null-pointer (* :void))))
330 (let ((x (OCIHandleAlloc
331 (uffi:pointer-address (uffi:deref-pointer *oci-env* oci-env))
335 +null-void-pointer+)))
355 (error "'~s' is not a valid OCI handle type" type))))
357 (defun oci-environment ()
358 (let ((envhp (oci-get-handle :type :env)))
359 (oci-env-init envhp 0 0 +null-void-pointer+)