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          (let ((result (funcall %lisp-oci-fn ,@ll)))
  98            (case result
  99              (#.+oci-success+
 100               +oci-success+)
 101              (#.+oci-error+
 102               (handle-oci-error :database database :nulls-ok nulls-ok))
 103              (#.+oci-no-data+
 104               (error "OCI No Data Found"))
 105              (#.+oci-success-with-info+
 106               (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
 107              (#.+oci-no-data+
 108               (error "OCI No Data"))
 109              (#.+oci-invalid-handle+
 110               (error "OCI Invalid Handle"))
 111              (#.+oci-need-data+
 112               (error "OCI Need Data"))
 113              (#.+oci-still-executing+
 114               (error "OCI Still Executing"))
 115              (#.+oci-continue+
 116               (error "OCI Continue"))
 117              (1804
 118               (error "Check ORACLE_HOME and NLS settings."))
 119              (t
 120               (error "OCI unknown error, code=~A" result))))))))
 121
 122
 123 (defmacro def-raw-oci-routine
 124   ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 125   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
 126     `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 127                              ,c-parms
 128                            :returning ,c-return)))
 129        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 130          (funcall %lisp-oci-fn ,@ll)))))
 131
 132
 133 (def-oci-routine ("OCIInitialize" oci-initialize)
 134     :int
 135   (mode :unsigned-long)                 ; ub4
 136   (ctxp (* :void))                          ; dvoid *
 137   (malocfp (* :void))                       ; dvoid *(*)
 138   (ralocfp (* :void))                       ; dvoid *(*)
 139   (mfreefp (* :void)))                      ; void *(*)
 140
 141
 142 (def-oci-routine ("OCIEnvInit" oci-env-init)
 143     :int
 144   (envpp (* :void))                         ; OCIEnv **
 145   (mode :unsigned-long)                  ; ub4
 146   (xtramem-sz :unsigned-long)            ; size_t
 147   (usermempp (* :void)))                    ; dvoid **
 148
 149 #+oci-8-1-5
 150 (def-oci-routine ("OCIEnvCreate" oci-env-create)
 151     :int
 152   (p0 (* :void))
 153   (p1 :unsigned-int)
 154   (p2 (* :void))
 155   (p3 (* :void))
 156   (p4 (* :void))
 157   (p5 (* :void))
 158   (p6 :unsigned-long)
 159   (p7 (* :void)))
 160
 161 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
 162     :int
 163   (parenth      (* :void))              ; const dvoid *
 164   (hndlpp       (* (* :void)))          ; dvoid **
 165   (type         :unsigned-long)         ; ub4
 166   (xtramem_sz   :unsigned-long)         ; size_t
 167   (usrmempp     (* (* :void))))         ; dvoid **
 168
 169 (def-oci-routine ("OCIServerAttach" oci-server-attach)
 170     :int
 171   (srvhp        (* :void))                  ; oci-server
 172   (errhp        (* :void))                  ; oci-error
 173   (dblink       :cstring)               ; :in
 174   (dblink-len   :unsigned-long)          ; int
 175   (mode         :unsigned-long))         ; int
 176
 177
 178 (def-oci-routine ("OCIHandleFree" oci-handle-free)
 179     :int
 180   (p0 (* :void)) ;; handle
 181   (p1 :unsigned-long)) ;;type
 182
 183 (def-oci-routine ("OCILogon" oci-logon)
 184     :int
 185   (envhp        (* :void))                  ; env
 186   (errhp        (* :void))                  ; err
 187   (svchp        (* :void))                  ; svc
 188   (username     :cstring)               ; username
 189   (uname-len    :unsigned-long)          ;
 190   (passwd       :cstring)               ; passwd
 191   (password-len :unsigned-long)          ;
 192   (dsn          :cstring)               ; datasource
 193   (dsn-len      :unsigned-long))         ;
 194
 195 (def-oci-routine ("OCILogoff" oci-logoff)
 196     :int
 197   (p0   (* :void))        ; svc
 198   (p1   (* :void)))       ; err
 199
 200 (uffi:def-function ("OCIErrorGet" oci-error-get)
 201     ((p0      (* :void))
 202      (p1      :unsigned-long)
 203      (p2      :cstring)
 204      (p3      (* :long))
 205      (p4      (* :void))
 206      (p5      :unsigned-long)
 207      (p6      :unsigned-long))
 208   :returning :void)
 209
 210 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
 211     :int
 212   (p0      (* :void))
 213   (p1      (* :void))
 214   (p2      :cstring)
 215   (p3      :unsigned-long)
 216   (p4      :unsigned-long)
 217   (p5      :unsigned-long))
 218
 219 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
 220     :int
 221   (p0      (* :void))
 222   (p1      (* :void))
 223   (p2      (* :void))
 224   (p3      :unsigned-long)
 225   (p4      :unsigned-long)
 226   (p5      (* :void))
 227   (p6      (* :void))
 228   (p7      :unsigned-long))
 229
 230 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
 231     :int
 232   (p0      (* :void))
 233   (p1      :unsigned-long)
 234   (p2      (* :void))
 235   (p3      (* :void))
 236   (p4      :unsigned-long))
 237
 238 (def-oci-routine ("OCIAttrGet" oci-attr-get)
 239     :int
 240   (p0      (* :void))
 241   (p1      :unsigned-long)
 242   (p2      (* :void))
 243   (p3      (* :unsigned-long))
 244   (p4      :unsigned-long)
 245   (p5      (* :void)))
 246
 247 #+nil
 248 (def-oci-routine ("OCIAttrSet" oci-attr-set)
 249     :int
 250   (trgthndlp (* :void))
 251   (trgthndltyp :int :in)
 252   (attributep (* :void))
 253   (size :int)
 254   (attrtype :int)
 255   (errhp oci-error))
 256
 257 (def-oci-routine ("OCIDefineByPos" oci-define-by-pos)
 258     :int
 259   (p0      (* :void))
 260   (p1      (* :void))
 261   (p2      (* :void))
 262   (p3      :unsigned-long)
 263   (p4      (* :void))
 264   (p5      :unsigned-long)
 265   (p6      :unsigned-short)
 266   (p7      (* :void))
 267   (p8      (* :void))
 268   (p9      (* :void))
 269   (p10     :unsigned-long))
 270
 271 (def-oci-routine ("OCIStmtFetch" oci-stmt-fetch)
 272     :int
 273   (stmthp       (* :void))
 274   (errhp        (* :void))
 275   (p2           :unsigned-long)
 276   (p3           :unsigned-short)
 277   (p4           :unsigned-long))
 278
 279
 280 (def-oci-routine ("OCITransStart" oci-trans-start)
 281   :int
 282   (svchp       (* :void))
 283   (errhp        (* :void))
 284   (p2           :unsigned-short)
 285   (p3           :unsigned-short))
 286
 287 (def-oci-routine ("OCITransCommit" oci-trans-commit)
 288   :int
 289   (svchp       (* :void))
 290   (errhp        (* :void))
 291   (p2           :unsigned-short))
 292
 293 (def-oci-routine ("OCITransRollback" oci-trans-rollback)
 294     :int
 295   (svchp       (* :void))
 296   (errhp        (* :void))
 297   (p2           :unsigned-short))
 298
 299
 300
 301 ;;; Functions
 302
 303 (defun oci-init (&key (mode +oci-default+))
 304   (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+ +null-void-pointer+ +null-void-pointer+)))
 305     (if (= x 0)
 306         (let ((env (uffi:make-pointer 0 oci-env)))
 307           (setq *oci-initialized* mode)
 308           (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
 309             (format t ";; OEI: returned ~d~%" x)
 310             (setq *oci-env* env))))))
 311
 312 (defun oci-check-return (value)
 313   (when (= value +oci-invalid-handle+)
 314     (error "Invalid Handle")))
 315
 316 (defun oci-get-handle (&key type)
 317   (if (null *oci-initialized*)
 318       (oci-init))
 319   (case type
 320     (:error
 321      (let ((ptr (uffi:make-pointer 0 (* :void))))
 322        (let ((x (OCIHandleAlloc
 323                  (uffi:pointer-address (uffi:deref-pointer *oci-env* oci-env))
 324                  ptr
 325                  +oci-default+
 326                  0
 327                  +null-void-pointer+)))
 328          (oci-check-return x)
 329          ptr)))
 330     (:service-context
 331      "OCISvcCtx")
 332     (:statement
 333      "OCIStmt")
 334     (:describe
 335      "OCIDescribe")
 336     (:server
 337      "OCIServer")
 338     (:session
 339      "OCISession")
 340     (:transaction
 341      "OCITrans")
 342     (:complex-object
 343      "OCIComplexObject")
 344     (:security
 345      "OCISecurity")
 346     (t
 347      (error "'~s' is not a valid OCI handle type" type))))
 348
 349 (defun oci-environment ()
 350   (let ((envhp (oci-get-handle :type :env)))
 351     (oci-env-init envhp 0 0 +null-void-pointer+)
 352     envhp))