+++ /dev/null
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name: oracle.lisp
-;;;; Purpose: Package definition for CLSQL Oracle interface
-;;;;
-;;;; $Id$
-;;;;
-;;;; This file is part of CLSQL.
-;;;;
-;;;; CLSQL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package #:clsql-oracle)
-
-
-;;
-;; Opaque pointer types
-;;
-
-(uffi:def-foreign-type void-pointer :pointer-void)
-(uffi:def-foreign-type oci-env :pointer-void)
-(uffi:def-foreign-type oci-server :pointer-void)
-(uffi:def-foreign-type oci-error :pointer-void)
-(uffi:def-foreign-type oci-svc-ctx :pointer-void)
-(uffi:def-foreign-type oci-stmt :pointer-void)
-
-
-(defvar +null-void-pointer+ (uffi:make-null-pointer :void))
-(defvar +null-void-pointer-pointer+ (uffi:make-null-pointer :pointer-void))
-
-;;; Check an OCI return code for erroricity and signal a reasonably
-;;; informative condition if so.
-;;;
-;;; ERRHP provides an error handle which can be used to find
-;;; subconditions; if it's not provided, subcodes won't be checked.
-;;;
-;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
-;;; normal and needn't cause any signal. An error handle is required
-;;; to detect this subcondition, so it doesn't make sense to set ERRHP
-;;; unless NULLS-OK is set.
-
-(defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
- (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
- `(let ((%lisp-oci-fn (uffi:def-function
- (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
- ,c-parms
- :returning ,c-return)))
- (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
- (let ((result (funcall %lisp-oci-fn ,@ll)))
- (case result
- (#.+oci-success+
- +oci-success+)
- (#.+oci-error+
- (handle-oci-error :database database :nulls-ok nulls-ok))
- (#.+oci-no-data+
- (error 'sql-database-error :message "OCI No Data Found"))
- (#.+oci-success-with-info+
- (error 'sql-database-error :message "internal error: unexpected +oci-success-with-info"))
- (#.+oci-no-data+
- (error 'sql-database-error :message "OCI No Data"))
- (#.+oci-invalid-handle+
- (error 'sql-database-error :message "OCI Invalid Handle"))
- (#.+oci-need-data+
- (error 'sql-database-error :message "OCI Need Data"))
- (#.+oci-still-executing+
- (error 'sql-temporary-error :message "OCI Still Executing"))
- (#.+oci-continue+
- (error 'sql-database-error :message "OCI Continue"))
- (1804
- (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
- (t
- (error 'sql-database-error
- :message
- (format nil "OCI unknown error, code=~A" result)))))))))
-
-
-(defmacro def-raw-oci-routine
- ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
- (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
- `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
- ,c-parms
- :returning ,c-return)))
- (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
- (funcall %lisp-oci-fn ,@ll)))))
-
-
-(def-oci-routine ("OCIInitialize" oci-initialize)
- :int
- (mode :unsigned-long) ; ub4
- (ctxp :pointer-void) ; dvoid *
- (malocfp :pointer-void) ; dvoid *(*)
- (ralocfp :pointer-void) ; dvoid *(*)
- (mfreefp (* :pointer-void))) ; void *(*)
-
-
-(def-oci-routine ("OCIEnvInit" oci-env-init)
- :int
- (envpp :pointer-void) ; OCIEnv **
- (mode :unsigned-long) ; ub4
- (xtramem-sz :unsigned-long) ; size_t
- (usermempp (* :pointer-void))) ; dvoid **
-
-#-oci7
-(def-oci-routine ("OCIEnvCreate" oci-env-create)
- :int
- (envhpp (* :pointer-void))
- (mode :unsigned-int)
- (ctxp :pointer-void)
- (malocfp :pointer-void)
- (ralocfp :pointer-void)
- (mfreefp :pointer-void)
- (xtramemsz :unsigned-long)
- (usrmempp (* :pointer-void)))
-
-(def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
- :int
- (parenth :pointer-void) ; const dvoid *
- (hndlpp (* :pointer-void)) ; dvoid **
- (type :unsigned-long) ; ub4
- (xtramem_sz :unsigned-long) ; size_t
- (usrmempp (* :pointer-void))) ; dvoid **
-
-(def-oci-routine ("OCIServerAttach" oci-server-attach)
- :int
- (srvhp :pointer-void) ; oci-server
- (errhp :pointer-void) ; oci-error
- (dblink :cstring) ; :in
- (dblink-len :unsigned-long) ; int
- (mode :unsigned-long)) ; int
-
-
-(def-oci-routine ("OCIHandleFree" oci-handle-free)
- :int
- (p0 :pointer-void) ;; handle
- (p1 :unsigned-long)) ;;type
-
-(def-oci-routine ("OCILogon" oci-logon)
- :int
- (envhp :pointer-void) ; env
- (errhp :pointer-void) ; err
- (svchpp (* :pointer-void)) ; svc
- (username :cstring) ; username
- (uname-len :unsigned-long) ;
- (passwd :cstring) ; passwd
- (password-len :unsigned-long) ;
- (dsn :cstring) ; datasource
- (dsn-len :unsigned-long)) ;
-
-(def-oci-routine ("OCILogoff" oci-logoff)
- :int
- (p0 :pointer-void) ; svc
- (p1 :pointer-void)) ; err
-
-(uffi:def-function ("OCIErrorGet" oci-error-get)
- ((handlp :pointer-void)
- (recordno :unsigned-long)
- (sqlstate :cstring)
- (errcodep (* :long))
- (bufp (* :unsigned-char))
- (bufsize :unsigned-long)
- (type :unsigned-long))
- :returning :void)
-
-(def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
- :int
- (stmtp :pointer-void)
- (errhp :pointer-void)
- (stmt :cstring)
- (stmt_len :unsigned-long)
- (language :unsigned-long)
- (mode :unsigned-long))
-
-(def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
- :int
- (svchp :pointer-void)
- (stmtp1 :pointer-void)
- (errhp :pointer-void)
- (iters :unsigned-long)
- (rowoff :unsigned-long)
- (snap_in :pointer-void)
- (snap_out :pointer-void)
- (mode :unsigned-long))
-
-(def-raw-oci-routine ("OCIParamGet" oci-param-get)
- :int
- (hndlp :pointer-void)
- (htype :unsigned-long)
- (errhp :pointer-void)
- (parmdpp (* :pointer-void))
- (pos :unsigned-long))
-
-(def-oci-routine ("OCIAttrGet" oci-attr-get)
- :int
- (trgthndlp :pointer-void)
- (trghndltyp :unsigned-int)
- (attributep :pointer-void)
- (sizep (* :unsigned-int))
- (attrtype :unsigned-int)
- (errhp :pointer-void))
-
-(def-oci-routine ("OCIAttrSet" oci-attr-set)
- :int
- (trgthndlp :pointer-void)
- (trgthndltyp :int :in)
- (attributep :pointer-void)
- (size :int)
- (attrtype :int)
- (errhp oci-error))
-
-(def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
- :int
- (stmtp :pointer-void)
- (defnpp (* :pointer-void))
- (errhp :pointer-void)
- (position :unsigned-long)
- (valuep :pointer-void)
- (value_sz :long)
- (dty :unsigned-short)
- (indp (* :short))
- (rlenp (* :unsigned-short))
- (rcodep (* :unsigned-short))
- (mode :unsigned-long))
-
-(def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
- :int
- (stmthp :pointer-void)
- (errhp :pointer-void)
- (p2 :unsigned-long)
- (p3 :unsigned-short)
- (p4 :unsigned-long))
-
-
-(def-oci-routine ("OCITransStart" oci-trans-start)
- :int
- (svchp :pointer-void)
- (errhp :pointer-void)
- (p2 :unsigned-short)
- (p3 :unsigned-short))
-
-(def-oci-routine ("OCITransCommit" oci-trans-commit)
- :int
- (svchp :pointer-void)
- (errhp :pointer-void)
- (p2 :unsigned-short))
-
-(def-oci-routine ("OCITransRollback" oci-trans-rollback)
- :int
- (svchp :pointer-void)
- (errhp :pointer-void)
- (p2 :unsigned-short))
-
-
-(def-oci-routine ("OCIServerVersion" oci-server-version)
- :int
- (handlp :pointer-void)
- (errhp :pointer-void)
- (bufp (* :unsigned-char))
- (bufsz :int)
- (hndltype :short))
-
-
-
-;;; Low-level routines that don't do error checking. They are used
-;;; for setting up global environment.
-
-(uffi:def-function "OCIInitialize"
- ((mode :unsigned-long) ; ub4
- (ctxp :pointer-void) ; dvoid *
- (malocfp :pointer-void) ; dvoid *(*)
- (ralocfp :pointer-void) ; dvoid *(*)
- (mfreefp (* :pointer-void)))
- :returning :int)
-
-(uffi:def-function "OCIEnvInit"
- ((envpp :pointer-void) ; OCIEnv **
- (mode :unsigned-long) ; ub4
- (xtramem-sz :unsigned-long) ; size_t
- (usermempp (* :pointer-void)))
- :returning :int)
-
-
-(uffi:def-function "OCIHandleAlloc"
- ((parenth :pointer-void) ; const dvoid *
- (hndlpp (* :pointer-void)) ; dvoid **
- (type :unsigned-long) ; ub4
- (xtramem_sz :unsigned-long) ; size_t
- (usrmempp (* :pointer-void)))
- :returning :int)
-
-(defstruct oci-handle
- (type :unknown)
- (pointer (uffi:allocate-foreign-object :pointer-void)))
-
-(defvar *oci-initialized* nil)
-(defvar *oci-env* nil)
-
-(defvar *oci-handle-types*
- '(:error ; error report handle (OCIError)
- :service-context ; service context handle (OCISvcCtx)
- :statement ; statement (application request) handle (OCIStmt)
- :describe ; select list description handle (OCIDescribe)
- :server ; server context handle (OCIServer)
- :session ; user session handle (OCISession)
- :transaction ; transaction context handle (OCITrans)
- :complex-object ; complex object retrieval handle (OCIComplexObject)
- :security)) ; security handle (OCISecurity)
-
-
-
-(defun oci-init (&key (mode +oci-default+))
- (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
- +null-void-pointer+ +null-void-pointer-pointer+)))
- (if (= x 0)
- (let ((env (uffi:allocate-foreign-object :pointer-void)))
- (setq *oci-initialized* mode)
- (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
- (format t ";; OEI: returned ~d~%" x)
- (setq *oci-env* env))))))
-
-(defun oci-check-return (value)
- (when (= value +oci-invalid-handle+)
- (error 'sql-database-error :message "Invalid Handle")))
-
-(defun oci-get-handle (&key type)
- (if (null *oci-initialized*)
- (oci-init))
- (case type
- (:error
- (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
- (let ((x (OCIHandleAlloc
- (uffi:deref-pointer *oci-env* void-pointer)
- ptr
- +oci-default+
- 0
- +null-void-pointer-pointer+)))
- (oci-check-return x)
- ptr)))
- (:service-context
- "OCISvcCtx")
- (:statement
- "OCIStmt")
- (:describe
- "OCIDescribe")
- (:server
- "OCIServer")
- (:session
- "OCISession")
- (:transaction
- "OCITrans")
- (:complex-object
- "OCIComplexObject")
- (:security
- "OCISecurity")
- (t
- (error 'sql-database-error
- :message
- (format nil "'~s' is not a valid OCI handle type" type)))))
-
-(defun oci-environment ()
- (let ((envhp (oci-get-handle :type :env)))
- (oci-env-init envhp 0 0 +null-void-pointer+)
- envhp))
projects / clsql.git / blobdiff