db-oracle/oracle.lisp

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