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))
56 (uffi:def-function "OCIInitialize"
64 (uffi:def-function "OCIEnvInit"
71 (uffi:def-function "OCIHandleAlloc"
79 ;;; Check an OCI return code for erroricity and signal a reasonably
80 ;;; informative condition if so.
82 ;;; ERRHP provides an error handle which can be used to find
83 ;;; subconditions; if it's not provided, subcodes won't be checked.
85 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
86 ;;; normal and needn't cause any signal. An error handle is required
87 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
88 ;;; unless NULLS-OK is set.
90 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
91 (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
92 `(let ((%lisp-oci-fn (uffi:def-function
93 (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
95 :returning ,c-return)))
96 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
97 (case (funcall %lisp-oci-fn ,@ll)
101 (handle-oci-error :database database :nulls-ok nulls-ok))
103 (error "OCI No Data Found"))
104 (#.+oci-success-with-info+
105 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
107 (error "OCI No Data"))
108 (#.+oci-invalid-handle+
109 (error "OCI Invalid Handle"))
111 (error "OCI Need Data"))
112 (#.+oci-still-executing+
113 (error "OCI Still Executing"))
115 (error "OCI Continue"))
117 (error "OCI unknown error, code=~A" (values))))))))
120 (defmacro def-raw-oci-routine
121 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
122 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
123 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
125 :returning ,c-return)))
126 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
127 (funcall %lisp-oci-fn ,@ll)))))
130 (def-oci-routine ("OCIInitialize" oci-initialize)
132 (mode :unsigned-long) ; ub4
133 (ctxp (* :void)) ; dvoid *
134 (malocfp (* :void)) ; dvoid *(*)
135 (ralocfp (* :void)) ; dvoid *(*)
136 (mfreefp (* :void))) ; void *(*)
139 (def-oci-routine ("OCIEnvInit" oci-env-init)
141 (envpp (* :void)) ; OCIEnv **
142 (mode :unsigned-long) ; ub4
143 (xtramem-sz :unsigned-long) ; size_t
144 (usermempp (* :void))) ; dvoid **
147 (def-oci-routine ("OCIEnvCreate" oci-env-create)
158 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
160 (parenth (* :void)) ; const dvoid *
161 (hndlpp (* :void)) ; dvoid **
162 (type :unsigned-long) ; ub4
163 (xtramem_sz :unsigned-long) ; size_t
164 (usrmempp (* :void))) ; dvoid **
166 (def-oci-routine ("OCIServerAttach" oci-server-attach)
168 (srvhp (* :void)) ; oci-server
169 (errhp (* :void)) ; oci-error
170 (dblink :cstring) ; :in
171 (dblink-len :unsigned-long) ; int
172 (mode :unsigned-long)) ; int
175 (def-oci-routine ("OCIHandleFree" oci-handle-free)
177 (p0 (* :void)) ;; handle
178 (p1 :unsigned-long)) ;;type
180 (def-oci-routine ("OCILogon" oci-logon)
182 (envhp (* :void)) ; env
183 (errhp (* :void)) ; err
184 (svchp (* :void)) ; svc
185 (username :cstring) ; username
186 (uname-len :unsigned-long) ;
187 (passwd :cstring) ; passwd
188 (password-len :unsigned-long) ;
189 (dsn :cstring) ; datasource
190 (dsn-len :unsigned-long)) ;
192 (def-oci-routine ("OCILogoff" oci-logoff)
195 (p1 (* :void))) ; err
197 (uffi:def-function ("OCIErrorGet" oci-error-get)
207 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
216 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
227 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
235 (def-oci-routine ("OCIAttrGet" oci-attr-get)
240 (p3 (* :unsigned-long))
245 (def-oci-routine ("OCIAttrSet" oci-attr-set)
247 (trgthndlp (* :void))
248 (trgthndltyp :int :in)
249 (attributep (* :void))
254 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
266 (p10 :unsigned-long))
268 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
277 (def-oci-routine ("OCITransStart" oci-trans-start)
282 (p3 :unsigned-short))
284 (def-oci-routine ("OCITransCommit" oci-trans-commit)
288 (p2 :unsigned-short))
290 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
294 (p2 :unsigned-short))
300 (defun oci-init (&key (mode +oci-default+))
301 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+)))
303 (let ((env (uffi:make-pointer 0 oci-env)))
304 (setq *oci-initialized* mode)
305 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
306 (format t ";; OEI: returned ~d~%" x)
307 (setq *oci-env* env))))))
309 (defun oci-check-return (value)
310 (when (= value +oci-invalid-handle+)
311 (error "Invalid Handle")))
313 (defun oci-get-handle (&key type)
314 (if (null *oci-initialized*)
318 (let ((ptr (uffi:make-pointer 0 (* :void))))
319 (let ((x (OCIHandleAlloc
320 (pointer-address (uffi:deref-pointer *oci-env* oci-env))
324 +null-void-pointer+)))
344 (error "'~s' is not a valid OCI handle type" type))))
346 (defun oci-environment ()
347 (let ((envhp (oci-get-handle :type :env)))
348 (oci-env-init envhp 0 0 +null-void-pointer+)