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)
21 (defvar *oci-initialized* nil)
23 (defvar *oci-env* nil)
27 ;; Opaque pointer types
30 (def-alien-type oci-env (* t))
32 (def-alien-type oci-server (* t))
34 (def-alien-type oci-error (* t))
36 (def-alien-type oci-svc-ctx (* t))
38 (def-alien-type oci-stmt (* t))
41 (defvar *oci-handle-types*
42 '(:error ; error report handle (OCIError)
43 :service-context ; service context handle (OCISvcCtx)
44 :statement ; statement (application request) handle (OCIStmt)
45 :describe ; select list description handle (OCIDescribe)
46 :server ; server context handle (OCIServer)
47 :session ; user session handle (OCISession)
48 :transaction ; transaction context handle (OCITrans)
49 :complex-object ; complex object retrieval handle (OCIComplexObject)
50 :security)) ; security handle (OCISecurity)
54 (pointer (make-alien (* t))))
56 (defun oci-init (&key (mode +oci-default+))
57 (let ((x (alien-funcall (extern-alien "OCIInitialize" (function int int (* t) (* t) (* t) (* t)))
58 mode nil nil nil nil)))
60 (let ((env (make-alien oci-env)))
61 (setq *oci-initialized* mode)
62 (let ((x (alien-funcall (extern-alien "OCIEnvInit" (function int (* t) int int (* t)))
63 env +oci-default+ 0 nil)))
64 (format t ";; OEI: reutrned ~d~%" x)
65 (setq *oci-env* env))))))
67 (defun oci-check-return (value)
68 (if (= value +oci-invalid-handle+)
69 (error "Invalid Handle")))
71 (defun oci-get-handle (&key type)
72 (if (null *oci-initialized*)
76 (let ((ptr (make-alien (* t))))
77 (let ((x (alien-funcall (extern-alien "OCIHandleAlloc" (function int unsigned-int (* t) int int (* t)))
78 (sap-ref-32 (alien-sap (deref *oci-env*)) 0)
102 (error "'~s' is not a valid OCI handle type" type))))
104 (defun oci-environment ()
105 (let ((envhp (oci-handle-alloc :type :env)))
109 ;;; Check an OCI return code for erroricity and signal a reasonably
110 ;;; informative condition if so.
112 ;;; ERRHP provides an error handle which can be used to find
113 ;;; subconditions; if it's not provided, subcodes won't be checked.
115 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
116 ;;; normal and needn't cause any signal. An error handle is required
117 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
118 ;;; unless NULLS-OK is set.
120 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
121 (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
122 `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
123 ,c-return ,@c-parms)))
124 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
125 (case (funcall %lisp-oci-fn ,@ll)
129 (handle-oci-error :database database :nulls-ok nulls-ok))
131 (error "OCI No Data Found"))
132 (#.+oci-success-with-info+
133 (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
135 (error "OCI No Data"))
136 (#.+oci-invalid-handle+
137 (error "OCI Invalid Handle"))
139 (error "OCI Need Data"))
140 (#.+oci-still-executing+
141 (error "OCI Still Executing"))
143 (error "OCI Continue"))
145 (error "OCI unknown error, code=~A" (values))))))))
148 (defmacro def-raw-oci-routine
149 ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
150 (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
151 `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
152 ,c-return ,@c-parms)))
153 (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
154 (funcall %lisp-oci-fn ,@ll)))))
157 (def-oci-routine ("OCIInitialize" OCI-INITIALIZE)
159 (mode unsigned-long) ; ub4
160 (ctxp (* t)) ; dvoid *
161 (malocfp (* t)) ; dvoid *(*)
162 (ralocfp (* t)) ; dvoid *(*)
163 (mfreefp (* t))) ; void *(*)
166 (def-oci-routine ("OCIEnvInit" OCI-ENV-INIT)
168 (envpp (* t)) ; OCIEnv **
169 (mode unsigned-long) ; ub4
170 (xtramem-sz unsigned-long) ; size_t
171 (usermempp (* t))) ; dvoid **
174 (def-oci-routine ("OCIEnvCreate" OCI-ENV-CREATE)
185 (def-oci-routine ("OCIHandleAlloc" OCI-HANDLE-ALLOC)
187 (parenth (* t)) ; const dvoid *
188 (hndlpp (* t)) ; dvoid **
189 (type unsigned-long) ; ub4
190 (xtramem_sz unsigned-long) ; size_t
191 (usrmempp (* t))) ; dvoid **
193 (def-oci-routine ("OCIServerAttach" OCI-SERVER-ATTACH)
195 (srvhp (* t)) ; oci-server
196 (errhp (* t)) ; oci-error
197 (dblink c-string) ; :in
198 (dblink-len unsigned-long) ; int
199 (mode unsigned-long)) ; int
202 (def-oci-routine ("OCIHandleFree" OCI-HANDLE-FREE)
205 (p1 unsigned-long)) ;;type
207 (def-oci-routine ("OCILogon" OCI-LOGON)
212 (username c-string) ; username
213 (uname-len unsigned-long) ;
214 (passwd c-string) ; passwd
215 (password-len unsigned-long) ;
216 (dsn c-string) ; datasource
217 (dsn-len unsigned-long)) ;
219 (def-oci-routine ("OCILogoff" OCI-LOGOFF)
224 (def-alien-routine ("OCIErrorGet" OCI-ERROR-GET)
234 (def-oci-routine ("OCIStmtPrepare" OCI-STMT-PREPARE)
243 (def-oci-routine ("OCIStmtExecute" OCI-STMT-EXECUTE)
254 (def-raw-oci-routine ("OCIParamGet" OCI-PARAM-GET)
262 (def-oci-routine ("OCIAttrGet" OCI-ATTR-GET)
267 (p3 (* unsigned-long))
272 (def-oci-routine ("OCIAttrSet" OCI-ATTR-SET)
275 (trgthndltyp int :in)
281 (def-oci-routine ("OCIDefineByPos" OCI-DEFINE-BY-POS)
295 (def-oci-routine ("OCIStmtFetch" OCI-STMT-FETCH)
304 (def-oci-routine ("OCITransStart" OCI-TRANS-START)
311 (def-oci-routine ("OCITransCommit" OCI-TRANS-COMMIT)
317 (def-oci-routine ("OCITransRollback" OCI-TRANS-ROLLBACK)