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