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