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-invalid-handle+
  64               (error 'sql-database-error :message "OCI Invalid Handle"))
  65              (#.+oci-need-data+
  66               (error 'sql-database-error :message "OCI Need Data"))
  67              (#.+oci-still-executing+
  68               (error 'sql-temporary-error :message "OCI Still Executing"))
  69              (#.+oci-continue+
  70               (error 'sql-database-error :message "OCI Continue"))
  71              (1804
  72               (error 'sql-database-error :message "Check ORACLE_HOME and NLS settings."))
  73              (t
  74               (error 'sql-database-error
  75                      :message
  76                      (format nil "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 #-oci7
 106 (def-oci-routine ("OCIEnvCreate" oci-env-create)
 107     :int
 108   (envhpp (* :pointer-void))
 109   (mode :unsigned-int)
 110   (ctxp :pointer-void)
 111   (malocfp :pointer-void)
 112   (ralocfp :pointer-void)
 113   (mfreefp :pointer-void)
 114   (xtramemsz :unsigned-long)
 115   (usrmempp (* :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      (* :short))
 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
 265 ;;; Low-level routines that don't do error checking. They are used
 266 ;;; for setting up global environment.
 267
 268 (uffi:def-function "OCIInitialize"
 269     ((mode :unsigned-long)                      ; ub4
 270      (ctxp :pointer-void)                       ; dvoid *
 271      (malocfp :pointer-void)                    ; dvoid *(*)
 272      (ralocfp :pointer-void)                    ; dvoid *(*)
 273      (mfreefp (* :pointer-void)))
 274   :returning :int)
 275
 276 (uffi:def-function "OCIEnvInit"
 277     ((envpp :pointer-void)                         ; OCIEnv **
 278      (mode :unsigned-long)                  ; ub4
 279      (xtramem-sz :unsigned-long)            ; size_t
 280      (usermempp (* :pointer-void)))
 281   :returning :int)
 282
 283
 284 (uffi:def-function "OCIHandleAlloc"
 285     ((parenth      :pointer-void)               ; const dvoid *
 286      (hndlpp       (* :pointer-void))           ; dvoid **
 287      (type         :unsigned-long)              ; ub4
 288      (xtramem_sz   :unsigned-long)              ; size_t
 289      (usrmempp     (* :pointer-void)))
 290   :returning :int)
 291
 292 (defstruct oci-handle
 293   (type :unknown)
 294   (pointer (uffi:allocate-foreign-object :pointer-void)))
 295
 296 (defvar *oci-initialized* nil)
 297 (defvar *oci-env* nil)
 298
 299 (defvar *oci-handle-types*
 300   '(:error                              ; error report handle (OCIError)
 301     :service-context                    ; service context handle (OCISvcCtx)
 302     :statement                          ; statement (application request) handle (OCIStmt)
 303     :describe                           ; select list description handle (OCIDescribe)
 304     :server                             ; server context handle (OCIServer)
 305     :session                            ; user session handle (OCISession)
 306     :transaction                        ; transaction context handle (OCITrans)
 307     :complex-object                     ; complex object retrieval handle (OCIComplexObject)
 308     :security))                         ; security handle (OCISecurity)
 309
 310
 311
 312 (defun oci-init (&key (mode +oci-default+))
 313   (let ((x (OCIInitialize mode +null-void-pointer+ +null-void-pointer+
 314                           +null-void-pointer+ +null-void-pointer-pointer+)))
 315     (if (= x 0)
 316         (let ((env (uffi:allocate-foreign-object :pointer-void)))
 317           (setq *oci-initialized* mode)
 318           (let ((x (OCIEnvInit env +oci-default+ 0 +null-void-pointer+)))
 319             (format t ";; OEI: returned ~d~%" x)
 320             (setq *oci-env* env))))))
 321
 322 (defun oci-check-return (value)
 323   (when (= value +oci-invalid-handle+)
 324     (error 'sql-database-error :message "Invalid Handle")))
 325
 326 (defun oci-get-handle (&key type)
 327   (if (null *oci-initialized*)
 328       (oci-init))
 329   (case type
 330     (:error
 331      (let ((ptr (uffi:allocate-foreign-object :pointer-void)))
 332        (let ((x (OCIHandleAlloc
 333                  (uffi:deref-pointer *oci-env* void-pointer)
 334                  ptr
 335                  +oci-default+
 336                  0
 337                  +null-void-pointer-pointer+)))
 338          (oci-check-return x)
 339          ptr)))
 340     (:service-context
 341      "OCISvcCtx")
 342     (:statement
 343      "OCIStmt")
 344     (:describe
 345      "OCIDescribe")
 346     (:server
 347      "OCIServer")
 348     (:session
 349      "OCISession")
 350     (:transaction
 351      "OCITrans")
 352     (:complex-object
 353      "OCIComplexObject")
 354     (:security
 355      "OCISecurity")
 356     (t
 357      (error 'sql-database-error
 358             :message
 359             (format nil "'~s' is not a valid OCI handle type" type)))))
 360
 361 (defun oci-environment ()
 362   (let ((envhp (oci-get-handle :type :env)))
 363     (oci-env-init envhp 0 0 +null-void-pointer+)
 364     envhp))