db-oracle/oracle.lisp

   1 ;;; -*- Mode: Lisp -*-
   2 ;;; $Id: oracle.lisp,v 1.1 2002/09/30 10:19:23 kevin Exp $
   3
   4 ;;; MaiSQL --- Common Lisp Interface Layer to SQL Databases
   5 ;;; This is copyrighted software.  See documentation for terms.
   6 ;;;
   7 ;;; oracle.lisp --- FFI interface to Oracle on Unix
   8 ;;;
   9 ;;; The present content of this file is orented specifically towards
  10 ;;; Oracle 8.0.5.1 under Linux, linking against libclntsh.so
  11
  12 (in-package :clsql-oracle)
  13
  14 ;;
  15
  16 (defvar *oci-initialized* nil)
  17
  18 (defvar *oci-env* nil)
  19
  20
  21 ;;
  22 ;; Opaque pointer types
  23 ;;
  24
  25 (def-alien-type oci-env (* t))
  26
  27 (def-alien-type oci-server (* t))
  28
  29 (def-alien-type oci-error (* t))
  30
  31 (def-alien-type oci-svc-ctx (* t))
  32
  33 (def-alien-type oci-stmt (* t))
  34
  35
  36 (defvar *oci-handle-types*
  37   '(:error                              ; error report handle (OCIError)
  38     :service-context                    ; service context handle (OCISvcCtx)
  39     :statement                          ; statement (application request) handle (OCIStmt)
  40     :describe                           ; select list description handle (OCIDescribe)
  41     :server                             ; server context handle (OCIServer)
  42     :session                            ; user session handle (OCISession)
  43     :transaction                        ; transaction context handle (OCITrans)
  44     :complex-object                     ; complex object retrieval handle (OCIComplexObject)
  45     :security))                         ; security handle (OCISecurity)
  46
  47 (defstruct oci-handle
  48   (type :unknown)
  49   (pointer (make-alien (* t))))
  50
  51 (defun oci-init (&key (mode +oci-default+))
  52   (let ((x (alien-funcall (extern-alien "OCIInitialize" (function int int (* t) (* t) (* t) (* t)))
  53                    mode nil nil nil nil)))
  54     (if (= x 0)
  55         (let ((env (make-alien oci-env)))
  56           (setq *oci-initialized* mode)
  57           (let ((x (alien-funcall (extern-alien "OCIEnvInit" (function int (* t) int int (* t)))
  58                                   env +oci-default+ 0 nil)))
  59             (format t ";; OEI: reutrned ~d~%" x)
  60             (setq *oci-env* env))))))
  61
  62 (defun oci-check-return (value)
  63   (if (= value +oci-invalid-handle+)
  64       (error "Invalid Handle")))
  65
  66 (defun oci-get-handle (&key type)
  67   (if (null *oci-initialized*)
  68       (oci-init))
  69   (case type
  70     (:error
  71      (let ((ptr (make-alien (* t))))
  72        (let ((x (alien-funcall (extern-alien "OCIHandleAlloc" (function int unsigned-int (* t) int int (* t)))
  73                                (sap-ref-32 (alien-sap (deref *oci-env*)) 0)
  74                                ptr
  75                                +oci-default+
  76                                0
  77                                nil)))
  78          (oci-check-return x)
  79          ptr)))
  80     (:service-context
  81      "OCISvcCtx")
  82     (:statement
  83      "OCIStmt")
  84     (:describe
  85      "OCIDescribe")
  86     (:server
  87      "OCIServer")
  88     (:session
  89      "OCISession")
  90     (:transaction
  91      "OCITrans")
  92     (:complex-object
  93      "OCIComplexObject")
  94     (:security
  95      "OCISecurity")
  96     (t
  97      (error "'~s' is not a valid OCI handle type" type))))
  98
  99 (defun oci-environment ()
 100   (let ((envhp (oci-handle-alloc :type :env)))
 101     (oci-env-init envhp)
 102     envhp))
 103
 104 ;;; Check an OCI return code for erroricity and signal a reasonably
 105 ;;; informative condition if so.
 106 ;;;
 107 ;;; ERRHP provides an error handle which can be used to find
 108 ;;; subconditions; if it's not provided, subcodes won't be checked.
 109 ;;;
 110 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
 111 ;;; normal and needn't cause any signal. An error handle is required
 112 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
 113 ;;; unless NULLS-OK is set.
 114
 115 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 116   (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
 117     `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 118                            ,c-return ,@c-parms)))
 119        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 120          (case (funcall %lisp-oci-fn ,@ll)
 121            (#.+oci-success+
 122             +oci-success+)
 123            (#.+oci-error+
 124             (handle-oci-error :database database :nulls-ok nulls-ok))
 125            (#.+oci-no-data+
 126             (error "OCI No Data Found"))
 127            (#.+oci-success-with-info+
 128             (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
 129            (#.+oci-no-data+
 130             (error "OCI No Data"))
 131            (#.+oci-invalid-handle+
 132             (error "OCI Invalid Handle"))
 133            (#.+oci-need-data+
 134             (error "OCI Need Data"))
 135            (#.+oci-still-executing+
 136             (error "OCI Still Executing"))
 137            (#.+oci-continue+
 138             (error "OCI Continue"))
 139            (t
 140             (error "OCI unknown error, code=~A" (values))))))))
 141
 142
 143 (defmacro def-raw-oci-routine
 144   ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 145   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
 146     `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 147                            ,c-return ,@c-parms)))
 148        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 149          (funcall %lisp-oci-fn ,@ll)))))
 150
 151
 152 (def-oci-routine ("OCIInitialize" OCI-INITIALIZE)
 153     int
 154   (mode unsigned-long)                  ; ub4
 155   (ctxp (* t))                          ; dvoid *
 156   (malocfp (* t))                       ; dvoid *(*)
 157   (ralocfp (* t))                       ; dvoid *(*)
 158   (mfreefp (* t)))                      ; void *(*)
 159
 160
 161 (def-oci-routine ("OCIEnvInit" OCI-ENV-INIT)
 162     int
 163   (envpp (* t))                         ; OCIEnv **
 164   (mode unsigned-long)                  ; ub4
 165   (xtramem-sz unsigned-long)            ; size_t
 166   (usermempp (* t)))                    ; dvoid **
 167
 168 #+oci-8-1-5
 169 (def-oci-routine ("OCIEnvCreate" OCI-ENV-CREATE)
 170     int
 171   (p0 (* t))
 172   (p1 unsigned-int)
 173   (p2 (* t))
 174   (p3 (* t))
 175   (p4 (* t))
 176   (p5 (* t))
 177   (p6 unsigned-long)
 178   (p7 (* t)))
 179
 180 (def-oci-routine ("OCIHandleAlloc" OCI-HANDLE-ALLOC)
 181     int
 182   (parenth      (* t))                  ; const dvoid *
 183   (hndlpp       (* t))                  ; dvoid **
 184   (type         unsigned-long)          ; ub4
 185   (xtramem_sz   unsigned-long)          ; size_t
 186   (usrmempp     (* t)))                 ; dvoid **
 187
 188 (def-oci-routine ("OCIServerAttach" OCI-SERVER-ATTACH)
 189     int
 190   (srvhp        (* t))                  ; oci-server
 191   (errhp        (* t))                  ; oci-error
 192   (dblink       c-string)               ; :in
 193   (dblink-len   unsigned-long)          ; int
 194   (mode         unsigned-long))         ; int
 195
 196
 197 (def-oci-routine ("OCIHandleFree" OCI-HANDLE-FREE)
 198     int
 199   (p0 (* t)) ;; handle
 200   (p1 unsigned-long)) ;;type
 201
 202 (def-oci-routine ("OCILogon" OCI-LOGON)
 203     int
 204   (envhp        (* t))                  ; env
 205   (errhp        (* t))                  ; err
 206   (svchp        (* t))                  ; svc
 207   (username     c-string)               ; username
 208   (uname-len    unsigned-long)          ;
 209   (passwd       c-string)               ; passwd
 210   (password-len unsigned-long)          ;
 211   (dsn          c-string)               ; datasource
 212   (dsn-len      unsigned-long))         ;
 213
 214 (def-oci-routine ("OCILogoff" OCI-LOGOFF)
 215     int
 216   (p0   (* t))        ; svc
 217   (p1   (* t)))       ; err
 218
 219 (def-alien-routine ("OCIErrorGet" OCI-ERROR-GET)
 220     void
 221   (p0      (* t))
 222   (p1      unsigned-long)
 223   (p2      c-string)
 224   (p3      (* long))
 225   (p4      (* t))
 226   (p5      unsigned-long)
 227   (p6      unsigned-long))
 228
 229 (def-oci-routine ("OCIStmtPrepare" OCI-STMT-PREPARE)
 230     int
 231   (p0      (* t))
 232   (p1      (* t))
 233   (p2      c-string)
 234   (p3      unsigned-long)
 235   (p4      unsigned-long)
 236   (p5      unsigned-long))
 237
 238 (def-oci-routine ("OCIStmtExecute" OCI-STMT-EXECUTE)
 239     int
 240   (p0      (* t))
 241   (p1      (* t))
 242   (p2      (* t))
 243   (p3      unsigned-long)
 244   (p4      unsigned-long)
 245   (p5      (* t))
 246   (p6      (* t))
 247   (p7      unsigned-long))
 248
 249 (def-raw-oci-routine ("OCIParamGet" OCI-PARAM-GET)
 250     int
 251   (p0      (* t))
 252   (p1      unsigned-long)
 253   (p2      (* t))
 254   (p3      (* t))
 255   (p4      unsigned-long))
 256
 257 (def-oci-routine ("OCIAttrGet" OCI-ATTR-GET)
 258     int
 259   (p0      (* t))
 260   (p1      unsigned-long)
 261   (p2      (* t))
 262   (p3      (* unsigned-long))
 263   (p4      unsigned-long)
 264   (p5      (* t)))
 265
 266 #+nil
 267 (def-oci-routine ("OCIAttrSet" OCI-ATTR-SET)
 268     int
 269   (trgthndlp (* t))
 270   (trgthndltyp int :in)
 271   (attributep (* t))
 272   (size int)
 273   (attrtype int)
 274   (errhp oci-error))
 275
 276 (def-oci-routine ("OCIDefineByPos" OCI-DEFINE-BY-POS)
 277     int
 278   (p0      (* t))
 279   (p1      (* t))
 280   (p2      (* t))
 281   (p3      unsigned-long)
 282   (p4      (* t))
 283   (p5      unsigned-long)
 284   (p6      unsigned-short)
 285   (p7      (* t))
 286   (p8      (* t))
 287   (p9      (* t))
 288   (p10     unsigned-long))
 289
 290 (def-oci-routine ("OCIStmtFetch" OCI-STMT-FETCH)
 291     int
 292   (stmthp       (* t))
 293   (errhp        (* t))
 294   (p2           unsigned-long)
 295   (p3           unsigned-short)
 296   (p4           unsigned-long))
 297
 298
 299 (def-oci-routine ("OCITransStart" OCI-TRANS-START)
 300   int
 301   (svchp       (* t))
 302   (errhp        (* t))
 303   (p2           unsigned-short)
 304   (p3           unsigned-short))
 305
 306 (def-oci-routine ("OCITransCommit" OCI-TRANS-COMMIT)
 307   int
 308   (svchp       (* t))
 309   (errhp        (* t))
 310   (p2           unsigned-short))
 311
 312 (def-oci-routine ("OCITransRollback" OCI-TRANS-ROLLBACK)
 313     int
 314   (svchp       (* t))
 315   (errhp        (* t))
 316   (p2           unsigned-short))
 317
 318