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