db-oracle/oracle-api.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 (defvar +null-void-pointer-pointer+ (uffi:make-null-pointer (* :void)))
  56
  57 (uffi:def-function "OCIInitialize"
  58     ((a :int)
  59      (b (* :void))
  60      (c (* :void))
  61      (d (* :void))
  62      (e (* :void)))
  63   :returning :int)
  64
  65 (uffi:def-function "OCIEnvInit"
  66     ((a (* :void))
  67      (b :int)
  68      (c :int)
  69      (d (* :void)))
  70   :returning :int)
  71
  72 (uffi:def-function "OCIHandleAlloc"
  73     ((a :unsigned-int)
  74      (b (* :void))
  75      (c :int)
  76      (d :int)
  77      (e (* :void)))
  78   :returning :int)
  79
  80 ;;; Check an OCI return code for erroricity and signal a reasonably
  81 ;;; informative condition if so.
  82 ;;;
  83 ;;; ERRHP provides an error handle which can be used to find
  84 ;;; subconditions; if it's not provided, subcodes won't be checked.
  85 ;;;
  86 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
  87 ;;; normal and needn't cause any signal. An error handle is required
  88 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
  89 ;;; unless NULLS-OK is set.
  90
  91 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
  92   (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
  93     `(let ((%lisp-oci-fn (uffi:def-function
  94                              (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
  95                              ,c-parms
  96                              :returning ,c-return)))
  97        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
  98          (let ((result (funcall %lisp-oci-fn ,@ll)))
  99            (case result
 100              (#.+oci-success+
 101               +oci-success+)
 102              (#.+oci-error+
 103               (handle-oci-error :database database :nulls-ok nulls-ok))
 104              (#.+oci-no-data+
 105               (error "OCI No Data Found"))
 106              (#.+oci-success-with-info+
 107               (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
 108              (#.+oci-no-data+
 109               (error "OCI No Data"))
 110              (#.+oci-invalid-handle+
 111               (error "OCI Invalid Handle"))
 112              (#.+oci-need-data+
 113               (error "OCI Need Data"))
 114              (#.+oci-still-executing+
 115               (error "OCI Still Executing"))
 116              (#.+oci-continue+
 117               (error "OCI Continue"))
 118              (1804
 119               (error "Check ORACLE_HOME and NLS settings."))
 120              (t
 121               (error "OCI unknown error, code=~A" result))))))))
 122
 123
 124 (defmacro def-raw-oci-routine
 125   ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 126   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
 127     `(let ((%lisp-oci-fn (uffi:def-function (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 128                              ,c-parms
 129                            :returning ,c-return)))
 130        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 131          (funcall %lisp-oci-fn ,@ll)))))
 132
 133
 134 (def-oci-routine ("OCIInitialize" oci-initialize)
 135     :int
 136   (mode :unsigned-long)                 ; ub4
 137   (ctxp (* :void))                      ; dvoid *
 138   (malocfp (* :void))                   ; dvoid *(*)
 139   (ralocfp (* :void))                   ; dvoid *(*)
 140   (mfreefp (* (* :void))))              ; void *(*)
 141
 142
 143 (def-oci-routine ("OCIEnvInit" oci-env-init)
 144     :int
 145   (envpp (* :void))                         ; OCIEnv **
 146   (mode :unsigned-long)                  ; ub4
 147   (xtramem-sz :unsigned-long)            ; size_t
 148   (usermempp (* (* :void))))                    ; dvoid **
 149
 150 #+oci-8-1-5
 151 (def-oci-routine ("OCIEnvCreate" oci-env-create)
 152     :int
 153   (p0 (* :void))
 154   (p1 :unsigned-int)
 155   (p2 (* :void))
 156   (p3 (* :void))
 157   (p4 (* :void))
 158   (p5 (* :void))
 159   (p6 :unsigned-long)
 160   (p7 (* :void)))
 161
 162 (def-oci-routine ("OCIHandleAlloc" oci-handle-alloc)
 163     :int
 164   (parenth      (* :void))              ; const dvoid *
 165   (hndlpp       (* (* :void)))          ; dvoid **
 166   (type         :unsigned-long)         ; ub4
 167   (xtramem_sz   :unsigned-long)         ; size_t
 168   (usrmempp     (* (* :void))))         ; dvoid **
 169
 170 (def-oci-routine ("OCIServerAttach" oci-server-attach)
 171     :int
 172   (srvhp        (* :void))                  ; oci-server
 173   (errhp        (* :void))                  ; oci-error
 174   (dblink       :cstring)               ; :in
 175   (dblink-len   :unsigned-long)          ; int
 176   (mode         :unsigned-long))         ; int
 177
 178
 179 (def-oci-routine ("OCIHandleFree" oci-handle-free)
 180     :int
 181   (p0 (* :void)) ;; handle
 182   (p1 :unsigned-long)) ;;type
 183
 184 (def-oci-routine ("OCILogon" oci-logon)
 185     :int
 186   (envhp        (* :void))              ; env
 187   (errhp        (* :void))              ; err
 188   (svchpp       (* (* :void)))          ; svc
 189   (username     :cstring)               ; username
 190   (uname-len    :unsigned-long)         ;
 191   (passwd       :cstring)               ; passwd
 192   (password-len :unsigned-long)         ;
 193   (dsn          :cstring)               ; datasource
 194   (dsn-len      :unsigned-long))        ;
 195
 196 (def-oci-routine ("OCILogoff" oci-logoff)
 197     :int
 198   (p0   (* :void))        ; svc
 199   (p1   (* :void)))       ; err
 200
 201 (uffi:def-function ("OCIErrorGet" oci-error-get)
 202     ((handlp  (* :void))
 203      (recordno  :unsigned-long)
 204      (sqlstate   :cstring)
 205      (errcodep   (* :long))
 206      (bufp      (* :unsigned-char))
 207      (bufsize      :unsigned-long)
 208      (type      :unsigned-long))
 209   :returning :void)
 210
 211 (def-oci-routine ("OCIStmtPrepare" oci-stmt-prepare)
 212     :int
 213   (stmtp      (* :void))
 214   (errhp      (* :void))
 215   (stmt      :cstring)
 216   (stmt_len      :unsigned-long)
 217   (language      :unsigned-long)
 218   (mode      :unsigned-long))
 219
 220 (def-oci-routine ("OCIStmtExecute" oci-stmt-execute)
 221     :int
 222   (svchp      (* :void))
 223   (stmtp1      (* :void))
 224   (errhp      (* :void))
 225   (iters      :unsigned-long)
 226   (rowoff      :unsigned-long)
 227   (snap_in      (* :void))
 228   (snap_out      (* :void))
 229   (mode     :unsigned-long))
 230
 231 (def-raw-oci-routine ("OCIParamGet" oci-param-get)
 232     :int
 233   (hndlp      (* :void))
 234   (htype      :unsigned-long)
 235   (errhp      (* :void))
 236   (parmdpp      (* (* :void)))
 237   (pos      :unsigned-long))
 238
 239 (def-oci-routine ("OCIAttrGet" oci-attr-get)
 240     :int
 241   (trgthndlp      (* :void))
 242   (trghndltyp      :unsigned-int)
 243   (attributep      (* :void))
 244   (sizep      (* :unsigned-int))
 245   (attrtype      :unsigned-int)
 246   (errhp      (* :void)))
 247
 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   (stmtp      (* :void))
 260   (defnpp     (* (* :void)))
 261   (errhp      (* :void))
 262   (position      :unsigned-long)
 263   (valuep      (* :void))
 264   (value_sz      :long)
 265   (dty      :unsigned-short)
 266   (indp      (* :void))
 267   (rlenp      (* :unsigned-short))
 268   (rcodep      (* :unsigned-short))
 269   (mode     :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-null-pointer (* :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))