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
)
40 (uffi:def-pointer-var
+null-void-pointer
+
41 (uffi:make-null-pointer
:void
))
42 (uffi:def-pointer-var
+null-void-pointer-pointer
+
43 (uffi:make-null-pointer
:pointer-void
))
45 ;;; Check an OCI return code for erroricity and signal a reasonably
46 ;;; informative condition if so.
48 ;;; ERRHP provides an error handle which can be used to find
49 ;;; subconditions; if it's not provided, subcodes won't be checked.
51 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
52 ;;; normal and needn't cause any signal. An error handle is required
53 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
54 ;;; unless NULLS-OK is set.
56 (defmacro def-oci-routine
((c-oci-symbol lisp-oci-fn
) c-return
&rest c-parms
)
57 (let ((ll (mapcar (lambda (x) (declare (ignore x
)) (gensym)) c-parms
))
58 (c-oci-fn (intern (concatenate 'string
"%" (symbol-name lisp-oci-fn
)))))
60 (declaim (inline ,c-oci-fn
,lisp-oci-fn
))
61 (uffi:def-function
(,c-oci-symbol
,c-oci-fn
)
64 (defun ,lisp-oci-fn
(,@ll
&key database nulls-ok
)
65 (let ((result (,c-oci-fn
,@ll
)))
66 (if (= result
#.
+oci-success
+)
68 (handle-oci-result result database nulls-ok
)))))))
71 (defmacro def-raw-oci-routine
72 ((c-oci-symbol lisp-oci-fn
) c-return
&rest c-parms
)
73 (let ((ll (mapcar (lambda (x) (declare (ignore x
)) (gensym)) c-parms
)))
74 `(let ((%lisp-oci-fn
(uffi:def-function
(,c-oci-symbol
,(intern (concatenate 'string
"%" (symbol-name lisp-oci-fn
))))
76 :returning
,c-return
)))
77 (defun ,lisp-oci-fn
(,@ll
&key database nulls-ok
)
78 (declare (ignore database nulls-ok
))
79 (funcall %lisp-oci-fn
,@ll
)))))
82 (def-oci-routine ("OCIInitialize" oci-initialize
)
85 (ctxp :pointer-void
) ; dvoid *
86 (malocfp :pointer-void
) ; dvoid *(*)
87 (ralocfp :pointer-void
) ; dvoid *(*)
88 (mfreefp (* :pointer-void
))) ; void *(*)
91 (def-oci-routine ("OCIEnvInit" oci-env-init
)
93 (envpp :pointer-void
) ; OCIEnv **
95 (xtramem-sz size_t
) ; size_t
96 (usermempp (* :pointer-void
))) ; dvoid **
99 (def-oci-routine ("OCIEnvCreate" oci-env-create
)
101 (envhpp (* :pointer-void
))
104 (malocfp :pointer-void
)
105 (ralocfp :pointer-void
)
106 (mfreefp :pointer-void
)
108 (usrmempp (* :pointer-void
)))
110 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc
)
112 (parenth :pointer-void
) ; const dvoid *
113 (hndlpp (* :pointer-void
)) ; dvoid **
115 (xtramem_sz size_t
) ; size_t
116 (usrmempp (* :pointer-void
))) ; dvoid **
118 (def-oci-routine ("OCIServerAttach" oci-server-attach
)
120 (srvhp :pointer-void
) ; oci-server
121 (errhp :pointer-void
) ; oci-error
122 (dblink :cstring
) ; :in
123 (dblink-len sb4
) ; sb4
127 (def-oci-routine ("OCIHandleFree" oci-handle-free
)
129 (p0 :pointer-void
) ;; handle
132 (def-oci-routine ("OCILogon" oci-logon
)
134 (envhp :pointer-void
) ; env
135 (errhp :pointer-void
) ; err
136 (svchpp (* :pointer-void
)) ; svc
137 (username (* :unsigned-char
)) ; username
139 (passwd (* :unsigned-char
)) ; passwd
141 (dsn (* :unsigned-char
)) ; datasource
144 (def-oci-routine ("OCILogoff" oci-logoff
)
146 (p0 :pointer-void
) ; svc
147 (p1 :pointer-void
)) ; err
149 (declaim (inline oci-error-get
))
150 (uffi:def-function
("OCIErrorGet" oci-error-get
)
151 ((handlp :pointer-void
)
155 (bufp (* :unsigned-char
))
160 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare
)
162 (stmtp :pointer-void
)
163 (errhp :pointer-void
)
164 (stmt (* :unsigned-char
))
169 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute
)
171 (svchp :pointer-void
)
172 (stmtp1 :pointer-void
)
173 (errhp :pointer-void
)
176 (snap_in :pointer-void
)
177 (snap_out :pointer-void
)
180 (def-raw-oci-routine ("OCIParamGet" oci-param-get
)
182 (hndlp :pointer-void
)
184 (errhp :pointer-void
)
185 (parmdpp (* :pointer-void
))
188 (def-oci-routine ("OCIAttrGet" oci-attr-get
)
190 (trgthndlp :pointer-void
)
192 (attributep :pointer-void
)
195 (errhp :pointer-void
))
197 (def-oci-routine ("OCIAttrSet" oci-attr-set
)
199 (trgthndlp :pointer-void
)
200 (trgthndltyp ub4
:in
)
201 (attributep :pointer-void
)
206 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos
)
208 (stmtp :pointer-void
)
209 (defnpp (* :pointer-void
))
210 (errhp :pointer-void
)
212 (valuep :pointer-void
)
220 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch
)
222 (stmthp :pointer-void
)
223 (errhp :pointer-void
)
229 (def-oci-routine ("OCITransStart" oci-trans-start
)
231 (svchp :pointer-void
)
232 (errhp :pointer-void
)
234 (p3 :unsigned-short
))
236 (def-oci-routine ("OCITransCommit" oci-trans-commit
)
238 (svchp :pointer-void
)
239 (errhp :pointer-void
)
240 (p2 :unsigned-short
))
242 (def-oci-routine ("OCITransRollback" oci-trans-rollback
)
244 (svchp :pointer-void
)
245 (errhp :pointer-void
)
246 (p2 :unsigned-short
))
249 (def-oci-routine ("OCIServerVersion" oci-server-version
)
251 (handlp :pointer-void
)
252 (errhp :pointer-void
)
253 (bufp (* :unsigned-char
))
259 ;;; Low-level routines that don't do error checking. They are used
260 ;;; for setting up global environment.
262 (uffi:def-function
"OCIInitialize"
264 (ctxp :pointer-void
) ; dvoid *
265 (malocfp :pointer-void
) ; dvoid *(*)
266 (ralocfp :pointer-void
) ; dvoid *(*)
267 (mfreefp (* :pointer-void
)))
270 (uffi:def-function
"OCIEnvInit"
271 ((envpp :pointer-void
) ; OCIEnv **
273 (xtramem-sz size_t
) ; size_t
274 (usermempp (* :pointer-void
)))
278 (uffi:def-function
"OCIHandleAlloc"
279 ((parenth :pointer-void
) ; const dvoid *
280 (hndlpp (* :pointer-void
)) ; dvoid **
282 (xtramem_sz size_t
) ; size_t
283 (usrmempp (* :pointer-void
)))
286 (defstruct oci-handle
288 (pointer (uffi:allocate-foreign-object
:pointer-void
)))
290 (defvar *oci-initialized
* nil
)
291 (defvar *oci-env
* nil
)
293 (defvar *oci-handle-types
*
294 '(:error
; error report handle (OCIError)
295 :service-context
; service context handle (OCISvcCtx)
296 :statement
; statement (application request) handle (OCIStmt)
297 :describe
; select list description handle (OCIDescribe)
298 :server
; server context handle (OCIServer)
299 :session
; user session handle (OCISession)
300 :transaction
; transaction context handle (OCITrans)
301 :complex-object
; complex object retrieval handle (OCIComplexObject)
302 :security
)) ; security handle (OCISecurity)
306 (defun oci-init (&key
(mode +oci-default
+))
307 (let ((x (OCIInitialize mode
+null-void-pointer
+ +null-void-pointer
+
308 +null-void-pointer
+ +null-void-pointer-pointer
+)))
310 (let ((env (uffi:allocate-foreign-object
:pointer-void
)))
311 (setq *oci-initialized
* mode
)
312 (let ((x (OCIEnvInit env
+oci-default
+ 0 +null-void-pointer
+)))
313 (format t
";; OEI: returned ~d~%" x
)
314 (setq *oci-env
* env
))))))
316 (defun oci-check-return (value)
317 (when (= value
+oci-invalid-handle
+)
318 (error 'sql-database-error
:message
"Invalid Handle")))
320 (defun oci-get-handle (&key type
)
321 (if (null *oci-initialized
*)
325 (let ((ptr (uffi:allocate-foreign-object
:pointer-void
)))
326 (let ((x (OCIHandleAlloc
327 (uffi:deref-pointer
*oci-env
* void-pointer
)
331 +null-void-pointer-pointer
+)))
351 (error 'sql-database-error
353 (format nil
"'~s' is not a valid OCI handle type" type
)))))
355 (defun oci-environment ()
356 (let ((envhp (oci-get-handle :type
:env
)))
357 (oci-env-init envhp
0 0 +null-void-pointer
+)