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