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 (let ((result (funcall %lisp-oci-fn ,@ll)))
102 (handle-oci-error :database database :nulls-ok nulls-ok))
104 (error "OCI No Data Found"))
105 (#.+oci-success-with-info+
106 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
108 (error "OCI No Data"))
109 (#.+oci-invalid-handle+
110 (error "OCI Invalid Handle"))
112 (error "OCI Need Data"))
113 (#.+oci-still-executing+
114 (error "OCI Still Executing"))
116 (error "OCI Continue"))
118 (error "Check ORACLE_HOME and NLS settings."))
120 (error "OCI unknown error, code=~A" result))))))))
123 (defmacro def-raw-oci-routine
124 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
125 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
126 `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
128 :returning ,c-return)))
129 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
130 (funcall %lisp-oci-fn ,@ll)))))
133 (def-oci-routine ("OCIInitialize" oci-initialize)
135 (mode :unsigned-long) ; ub4
136 (ctxp (* :void)) ; dvoid *
137 (malocfp (* :void)) ; dvoid *(*)
138 (ralocfp (* :void)) ; dvoid *(*)
139 (mfreefp (* :void))) ; void *(*)
142 (def-oci-routine ("OCIEnvInit" oci-env-init)
144 (envpp (* :void)) ; OCIEnv **
145 (mode :unsigned-long) ; ub4
146 (xtramem-sz :unsigned-long) ; size_t
147 (usermempp (* :void))) ; dvoid **
150 (def-oci-routine ("OCIEnvCreate" oci-env-create)
161 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
163 (parenth (* :void)) ; const dvoid *
164 (hndlpp (* (* :void))) ; dvoid **
165 (type :unsigned-long) ; ub4
166 (xtramem_sz :unsigned-long) ; size_t
167 (usrmempp (* (* :void)))) ; dvoid **
169 (def-oci-routine ("OCIServerAttach" oci-server-attach)
171 (srvhp (* :void)) ; oci-server
172 (errhp (* :void)) ; oci-error
173 (dblink :cstring) ; :in
174 (dblink-len :unsigned-long) ; int
175 (mode :unsigned-long)) ; int
178 (def-oci-routine ("OCIHandleFree" oci-handle-free)
180 (p0 (* :void)) ;; handle
181 (p1 :unsigned-long)) ;;type
183 (def-oci-routine ("OCILogon" oci-logon)
185 (envhp (* :void)) ; env
186 (errhp (* :void)) ; err
187 (svchp (* :void)) ; svc
188 (username :cstring) ; username
189 (uname-len :unsigned-long) ;
190 (passwd :cstring) ; passwd
191 (password-len :unsigned-long) ;
192 (dsn :cstring) ; datasource
193 (dsn-len :unsigned-long)) ;
195 (def-oci-routine ("OCILogoff" oci-logoff)
198 (p1 (* :void))) ; err
200 (uffi:def-function ("OCIErrorGet" oci-error-get)
210 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
219 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
230 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
238 (def-oci-routine ("OCIAttrGet" oci-attr-get)
243 (p3 (* :unsigned-long))
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)
269 (p10 :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))
303 (defun oci-init (&key (mode +oci-default+))
304 (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+)))
306 (let ((env (uffi:make-pointer 0 oci-env)))
307 (setq *oci-initialized* mode)
308 (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
309 (format t ";; OEI: returned ~d~%" x)
310 (setq *oci-env* env))))))
312 (defun oci-check-return (value)
313 (when (= value +oci-invalid-handle+)
314 (error "Invalid Handle")))
316 (defun oci-get-handle (&key type)
317 (if (null *oci-initialized*)
321 (let ((ptr (uffi:make-pointer 0 (* :void))))
322 (let ((x (OCIHandleAlloc
323 (uffi:pointer-address (uffi:deref-pointer *oci-env* oci-env))
327 +null-void-pointer+)))
347 (error "'~s' is not a valid OCI handle type" type))))
349 (defun oci-environment ()
350 (let ((envhp (oci-get-handle :type :env)))
351 (oci-env-init envhp 0 0 +null-void-pointer+)