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