X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=db-oracle%2Foracle.cl;fp=db-oracle%2Foracle.cl;h=bde69eb15fc487364a5d0d46fee8f8e343f0a33c;hb=7b296f477e74a6db6e319e6cb6dff16be44e6a60;hp=0000000000000000000000000000000000000000;hpb=b0770ce015dd263398ea13f1df810173574a6752;p=clsql.git

diff --git a/db-oracle/oracle.cl b/db-oracle/oracle.cl
new file mode 100644
index 0000000..bde69eb
--- /dev/null
+++ b/db-oracle/oracle.cl
@@ -0,0 +1,318 @@
+;;; -*- Mode: Lisp -*-
+;;; $Id: oracle.cl,v 1.1 2002/09/18 07:43:41 kevin Exp $
+
+;;; MaiSQL --- Common Lisp Interface Layer to SQL Databases
+;;; This is copyrighted software.  See documentation for terms.
+;;; 
+;;; oracle.lisp --- FFI interface to Oracle on Unix
+;;;
+;;; The present content of this file is orented specifically towards
+;;; Oracle 8.0.5.1 under Linux, linking against libclntsh.so
+
+(in-package :clsql-oracle)
+
+;;
+
+(defvar *oci-initialized* nil)
+
+(defvar *oci-env* nil)
+
+
+;;
+;; Opaque pointer types
+;;
+
+(def-alien-type oci-env (* t))
+
+(def-alien-type oci-server (* t))
+
+(def-alien-type oci-error (* t))
+
+(def-alien-type oci-svc-ctx (* t))
+
+(def-alien-type oci-stmt (* t))
+
+
+(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)
+
+(defstruct oci-handle
+  (type :unknown)
+  (pointer (make-alien (* t))))
+
+(defun oci-init (&key (mode +oci-default+))
+  (let ((x (alien-funcall (extern-alien "OCIInitialize" (function int int (* t) (* t) (* t) (* t)))
+		   mode nil nil nil nil)))
+    (if (= x 0)
+	(let ((env (make-alien oci-env)))
+	  (setq *oci-initialized* mode)
+	  (let ((x (alien-funcall (extern-alien "OCIEnvInit" (function int (* t) int int (* t)))
+				  env +oci-default+ 0 nil)))
+	    (format t ";; OEI: reutrned ~d~%" x)
+	    (setq *oci-env* env))))))
+
+(defun oci-check-return (value)
+  (if (= value +oci-invalid-handle+)
+      (error "Invalid Handle")))
+
+(defun oci-get-handle (&key type)
+  (if (null *oci-initialized*)
+      (oci-init))
+  (case type
+    (:error
+     (let ((ptr (make-alien (* t))))
+       (let ((x (alien-funcall (extern-alien "OCIHandleAlloc" (function int unsigned-int (* t) int int (* t)))
+			       (sap-ref-32 (alien-sap (deref *oci-env*)) 0)
+			       ptr
+			       +oci-default+
+			       0
+			       nil)))
+	 (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 "'~s' is not a valid OCI handle type" type))))
+
+(defun oci-environment ()
+  (let ((envhp (oci-handle-alloc :type :env)))
+    (oci-env-init envhp)
+    envhp))
+
+;;; 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) (gensym)) c-parms)))
+    `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
+			   ,c-return ,@c-parms)))
+       (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
+	 (case (funcall %lisp-oci-fn ,@ll)
+	   (#.+oci-success+
+	    +oci-success+)
+	   (#.+oci-error+
+	    (handle-oci-error :database database :nulls-ok nulls-ok))
+	   (#.+oci-no-data+
+	    (error "OCI No Data Found"))
+	   (#.+oci-success-with-info+
+	    (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
+	   (#.+oci-no-data+
+	    (error "OCI No Data"))
+	   (#.+oci-invalid-handle+
+	    (error "OCI Invalid Handle"))
+	   (#.+oci-need-data+
+	    (error "OCI Need Data"))
+	   (#.+oci-still-executing+
+	    (error "OCI Still Executing"))
+	   (#.+oci-continue+
+	    (error "OCI Continue"))
+	   (t
+	    (error "OCI unknown error, code=~A" (values))))))))
+  
+
+(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 (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
+			   ,c-return ,@c-parms)))
+       (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 (* t))                          ; dvoid *
+  (malocfp (* t))                       ; dvoid *(*)
+  (ralocfp (* t))                       ; dvoid *(*)
+  (mfreefp (* t)))                      ; void *(*)
+
+
+(def-oci-routine ("OCIEnvInit" OCI-ENV-INIT)
+    int
+  (envpp (* t))                         ; OCIEnv **
+  (mode unsigned-long)                  ; ub4
+  (xtramem-sz unsigned-long)            ; size_t
+  (usermempp (* t)))                    ; dvoid **
+  
+#+oci-8-1-5
+(def-oci-routine ("OCIEnvCreate" OCI-ENV-CREATE)
+    int
+  (p0 (* t))
+  (p1 unsigned-int)
+  (p2 (* t))
+  (p3 (* t))
+  (p4 (* t))
+  (p5 (* t))
+  (p6 unsigned-long)
+  (p7 (* t)))
+
+(def-oci-routine ("OCIHandleAlloc" OCI-HANDLE-ALLOC)
+    int
+  (parenth      (* t))                  ; const dvoid *
+  (hndlpp       (* t))                  ; dvoid **
+  (type         unsigned-long)          ; ub4
+  (xtramem_sz   unsigned-long)          ; size_t
+  (usrmempp     (* t)))                 ; dvoid **
+
+(def-oci-routine ("OCIServerAttach" OCI-SERVER-ATTACH)
+    int
+  (srvhp        (* t))                  ; oci-server
+  (errhp        (* t))                  ; oci-error
+  (dblink       c-string)               ; :in
+  (dblink-len   unsigned-long)          ; int
+  (mode         unsigned-long))         ; int
+
+
+(def-oci-routine ("OCIHandleFree" OCI-HANDLE-FREE)
+    int
+  (p0 (* t)) ;; handle
+  (p1 unsigned-long)) ;;type
+
+(def-oci-routine ("OCILogon" OCI-LOGON)
+    int
+  (envhp        (* t))                  ; env
+  (errhp        (* t))                  ; err
+  (svchp        (* t))                  ; svc
+  (username     c-string)               ; username
+  (uname-len    unsigned-long)          ;
+  (passwd       c-string)               ; passwd
+  (password-len unsigned-long)          ;
+  (dsn          c-string)               ; datasource
+  (dsn-len      unsigned-long))         ;
+
+(def-oci-routine ("OCILogoff" OCI-LOGOFF)
+    int
+  (p0	(* t))        ; svc
+  (p1	(* t)))       ; err
+
+(def-alien-routine ("OCIErrorGet" OCI-ERROR-GET)
+    void
+  (p0      (* t))
+  (p1      unsigned-long)
+  (p2      c-string)
+  (p3      (* long))
+  (p4      (* t))
+  (p5      unsigned-long)
+  (p6      unsigned-long))
+
+(def-oci-routine ("OCIStmtPrepare" OCI-STMT-PREPARE)
+    int
+  (p0      (* t))
+  (p1      (* t))
+  (p2      c-string)
+  (p3      unsigned-long)
+  (p4      unsigned-long)
+  (p5      unsigned-long))
+
+(def-oci-routine ("OCIStmtExecute" OCI-STMT-EXECUTE)
+    int
+  (p0      (* t))
+  (p1      (* t))
+  (p2      (* t))
+  (p3      unsigned-long)
+  (p4      unsigned-long)
+  (p5      (* t))
+  (p6      (* t))
+  (p7      unsigned-long))
+
+(def-raw-oci-routine ("OCIParamGet" OCI-PARAM-GET)
+    int
+  (p0      (* t))
+  (p1      unsigned-long)
+  (p2      (* t))
+  (p3      (* t))
+  (p4      unsigned-long))
+
+(def-oci-routine ("OCIAttrGet" OCI-ATTR-GET)
+    int
+  (p0      (* t))
+  (p1      unsigned-long)
+  (p2      (* t))
+  (p3      (* unsigned-long))
+  (p4      unsigned-long)
+  (p5      (* t)))
+
+#+nil
+(def-oci-routine ("OCIAttrSet" OCI-ATTR-SET)
+    int
+  (trgthndlp (* t))
+  (trgthndltyp int :in)
+  (attributep (* t))
+  (size int)
+  (attrtype int)
+  (errhp oci-error))
+
+(def-oci-routine ("OCIDefineByPos" OCI-DEFINE-BY-POS)
+    int
+  (p0      (* t))
+  (p1      (* t))
+  (p2      (* t))
+  (p3      unsigned-long)
+  (p4      (* t))
+  (p5      unsigned-long)
+  (p6      unsigned-short)         
+  (p7      (* t))
+  (p8      (* t))          
+  (p9      (* t))          
+  (p10     unsigned-long))
+
+(def-oci-routine ("OCIStmtFetch" OCI-STMT-FETCH)
+    int
+  (stmthp       (* t))
+  (errhp        (* t))
+  (p2           unsigned-long)
+  (p3           unsigned-short)
+  (p4           unsigned-long))
+
+
+(def-oci-routine ("OCITransStart" OCI-TRANS-START)
+  int
+  (svchp       (* t))
+  (errhp        (* t))
+  (p2           unsigned-short)
+  (p3           unsigned-short))
+
+(def-oci-routine ("OCITransCommit" OCI-TRANS-COMMIT)
+  int
+  (svchp       (* t))
+  (errhp        (* t))
+  (p2           unsigned-short))
+
+(def-oci-routine ("OCITransRollback" OCI-TRANS-ROLLBACK)
+    int
+  (svchp       (* t))
+  (errhp        (* t))
+  (p2           unsigned-short))
+
+