X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=db-db2%2Fdb2-api.lisp;fp=db-db2%2Fdb2-api.lisp;h=61de25cce960c9e110ecb41aaef60e40ec823e18;hb=3770e7b13ca9fe756505f9cd90636ea18a5b5d63;hp=0000000000000000000000000000000000000000;hpb=fe038ef290c0c055d42c39ac699bc25585d74874;p=clsql.git diff --git a/db-db2/db2-api.lisp b/db-db2/db2-api.lisp new file mode 100644 index 0000000..61de25c --- /dev/null +++ b/db-db2/db2-api.lisp @@ -0,0 +1,366 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; ************************************************************************* +;;;; FILE IDENTIFICATION +;;;; +;;;; Name: db2.lisp +;;;; Purpose: Package definition for CLSQL Db2 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-db2) + + +;; +;; 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 DB2_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))