db-oracle/oracle.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, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
  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 (defvar *oci-initialized* nil)
  22
  23 (defvar *oci-env* nil)
  24
  25
  26 ;;
  27 ;; Opaque pointer types
  28 ;;
  29
  30 (def-alien-type oci-env (* t))
  31
  32 (def-alien-type oci-server (* t))
  33
  34 (def-alien-type oci-error (* t))
  35
  36 (def-alien-type oci-svc-ctx (* t))
  37
  38 (def-alien-type oci-stmt (* t))
  39
  40
  41 (defvar *oci-handle-types*
  42   '(:error                              ; error report handle (OCIError)
  43     :service-context                    ; service context handle (OCISvcCtx)
  44     :statement                          ; statement (application request) handle (OCIStmt)
  45     :describe                           ; select list description handle (OCIDescribe)
  46     :server                             ; server context handle (OCIServer)
  47     :session                            ; user session handle (OCISession)
  48     :transaction                        ; transaction context handle (OCITrans)
  49     :complex-object                     ; complex object retrieval handle (OCIComplexObject)
  50     :security))                         ; security handle (OCISecurity)
  51
  52 (defstruct oci-handle
  53   (type :unknown)
  54   (pointer (make-alien (* t))))
  55
  56 (defun oci-init (&key (mode +oci-default+))
  57   (let ((x (alien-funcall (extern-alien "OCIInitialize" (function int int (* t) (* t) (* t) (* t)))
  58                    mode nil nil nil nil)))
  59     (if (= x 0)
  60         (let ((env (make-alien oci-env)))
  61           (setq *oci-initialized* mode)
  62           (let ((x (alien-funcall (extern-alien "OCIEnvInit" (function int (* t) int int (* t)))
  63                                   env +oci-default+ 0 nil)))
  64             (format t ";; OEI: reutrned ~d~%" x)
  65             (setq *oci-env* env))))))
  66
  67 (defun oci-check-return (value)
  68   (if (= value +oci-invalid-handle+)
  69       (error "Invalid Handle")))
  70
  71 (defun oci-get-handle (&key type)
  72   (if (null *oci-initialized*)
  73       (oci-init))
  74   (case type
  75     (:error
  76      (let ((ptr (make-alien (* t))))
  77        (let ((x (alien-funcall (extern-alien "OCIHandleAlloc" (function int unsigned-int (* t) int int (* t)))
  78                                (sap-ref-32 (alien-sap (deref *oci-env*)) 0)
  79                                ptr
  80                                +oci-default+
  81                                0
  82                                nil)))
  83          (oci-check-return x)
  84          ptr)))
  85     (:service-context
  86      "OCISvcCtx")
  87     (:statement
  88      "OCIStmt")
  89     (:describe
  90      "OCIDescribe")
  91     (:server
  92      "OCIServer")
  93     (:session
  94      "OCISession")
  95     (:transaction
  96      "OCITrans")
  97     (:complex-object
  98      "OCIComplexObject")
  99     (:security
 100      "OCISecurity")
 101     (t
 102      (error "'~s' is not a valid OCI handle type" type))))
 103
 104 (defun oci-environment ()
 105   (let ((envhp (oci-handle-alloc :type :env)))
 106     (oci-env-init envhp)
 107     envhp))
 108
 109 ;;; Check an OCI return code for erroricity and signal a reasonably
 110 ;;; informative condition if so.
 111 ;;;
 112 ;;; ERRHP provides an error handle which can be used to find
 113 ;;; subconditions; if it's not provided, subcodes won't be checked.
 114 ;;;
 115 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
 116 ;;; normal and needn't cause any signal. An error handle is required
 117 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
 118 ;;; unless NULLS-OK is set.
 119
 120 (defmacro def-oci-routine ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 121   (let ((ll (mapcar (lambda (x) (gensym)) c-parms)))
 122     `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 123                            ,c-return ,@c-parms)))
 124        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 125          (case (funcall %lisp-oci-fn ,@ll)
 126            (#.+oci-success+
 127             +oci-success+)
 128            (#.+oci-error+
 129             (handle-oci-error :database database :nulls-ok nulls-ok))
 130            (#.+oci-no-data+
 131             (error "OCI No Data Found"))
 132            (#.+oci-success-with-info+
 133             (error "internal error: unexpected +oci-SUCCESS-WITH-INFO"))
 134            (#.+oci-no-data+
 135             (error "OCI No Data"))
 136            (#.+oci-invalid-handle+
 137             (error "OCI Invalid Handle"))
 138            (#.+oci-need-data+
 139             (error "OCI Need Data"))
 140            (#.+oci-still-executing+
 141             (error "OCI Still Executing"))
 142            (#.+oci-continue+
 143             (error "OCI Continue"))
 144            (t
 145             (error "OCI unknown error, code=~A" (values))))))))
 146
 147
 148 (defmacro def-raw-oci-routine
 149   ((c-oci-symbol lisp-oci-fn) c-return &rest c-parms)
 150   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
 151     `(let ((%lisp-oci-fn (def-alien-routine (,c-oci-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-oci-fn))))
 152                            ,c-return ,@c-parms)))
 153        (defun ,lisp-oci-fn (,@ll &key database nulls-ok)
 154          (funcall %lisp-oci-fn ,@ll)))))
 155
 156
 157 (def-oci-routine ("OCIInitialize" OCI-INITIALIZE)
 158     int
 159   (mode unsigned-long)                  ; ub4
 160   (ctxp (* t))                          ; dvoid *
 161   (malocfp (* t))                       ; dvoid *(*)
 162   (ralocfp (* t))                       ; dvoid *(*)
 163   (mfreefp (* t)))                      ; void *(*)
 164
 165
 166 (def-oci-routine ("OCIEnvInit" OCI-ENV-INIT)
 167     int
 168   (envpp (* t))                         ; OCIEnv **
 169   (mode unsigned-long)                  ; ub4
 170   (xtramem-sz unsigned-long)            ; size_t
 171   (usermempp (* t)))                    ; dvoid **
 172
 173 #+oci-8-1-5
 174 (def-oci-routine ("OCIEnvCreate" OCI-ENV-CREATE)
 175     int
 176   (p0 (* t))
 177   (p1 unsigned-int)
 178   (p2 (* t))
 179   (p3 (* t))
 180   (p4 (* t))
 181   (p5 (* t))
 182   (p6 unsigned-long)
 183   (p7 (* t)))
 184
 185 (def-oci-routine ("OCIHandleAlloc" OCI-HANDLE-ALLOC)
 186     int
 187   (parenth      (* t))                  ; const dvoid *
 188   (hndlpp       (* t))                  ; dvoid **
 189   (type         unsigned-long)          ; ub4
 190   (xtramem_sz   unsigned-long)          ; size_t
 191   (usrmempp     (* t)))                 ; dvoid **
 192
 193 (def-oci-routine ("OCIServerAttach" OCI-SERVER-ATTACH)
 194     int
 195   (srvhp        (* t))                  ; oci-server
 196   (errhp        (* t))                  ; oci-error
 197   (dblink       c-string)               ; :in
 198   (dblink-len   unsigned-long)          ; int
 199   (mode         unsigned-long))         ; int
 200
 201
 202 (def-oci-routine ("OCIHandleFree" OCI-HANDLE-FREE)
 203     int
 204   (p0 (* t)) ;; handle
 205   (p1 unsigned-long)) ;;type
 206
 207 (def-oci-routine ("OCILogon" OCI-LOGON)
 208     int
 209   (envhp        (* t))                  ; env
 210   (errhp        (* t))                  ; err
 211   (svchp        (* t))                  ; svc
 212   (username     c-string)               ; username
 213   (uname-len    unsigned-long)          ;
 214   (passwd       c-string)               ; passwd
 215   (password-len unsigned-long)          ;
 216   (dsn          c-string)               ; datasource
 217   (dsn-len      unsigned-long))         ;
 218
 219 (def-oci-routine ("OCILogoff" OCI-LOGOFF)
 220     int
 221   (p0   (* t))        ; svc
 222   (p1   (* t)))       ; err
 223
 224 (def-alien-routine ("OCIErrorGet" OCI-ERROR-GET)
 225     void
 226   (p0      (* t))
 227   (p1      unsigned-long)
 228   (p2      c-string)
 229   (p3      (* long))
 230   (p4      (* t))
 231   (p5      unsigned-long)
 232   (p6      unsigned-long))
 233
 234 (def-oci-routine ("OCIStmtPrepare" OCI-STMT-PREPARE)
 235     int
 236   (p0      (* t))
 237   (p1      (* t))
 238   (p2      c-string)
 239   (p3      unsigned-long)
 240   (p4      unsigned-long)
 241   (p5      unsigned-long))
 242
 243 (def-oci-routine ("OCIStmtExecute" OCI-STMT-EXECUTE)
 244     int
 245   (p0      (* t))
 246   (p1      (* t))
 247   (p2      (* t))
 248   (p3      unsigned-long)
 249   (p4      unsigned-long)
 250   (p5      (* t))
 251   (p6      (* t))
 252   (p7      unsigned-long))
 253
 254 (def-raw-oci-routine ("OCIParamGet" OCI-PARAM-GET)
 255     int
 256   (p0      (* t))
 257   (p1      unsigned-long)
 258   (p2      (* t))
 259   (p3      (* t))
 260   (p4      unsigned-long))
 261
 262 (def-oci-routine ("OCIAttrGet" OCI-ATTR-GET)
 263     int
 264   (p0      (* t))
 265   (p1      unsigned-long)
 266   (p2      (* t))
 267   (p3      (* unsigned-long))
 268   (p4      unsigned-long)
 269   (p5      (* t)))
 270
 271 #+nil
 272 (def-oci-routine ("OCIAttrSet" OCI-ATTR-SET)
 273     int
 274   (trgthndlp (* t))
 275   (trgthndltyp int :in)
 276   (attributep (* t))
 277   (size int)
 278   (attrtype int)
 279   (errhp oci-error))
 280
 281 (def-oci-routine ("OCIDefineByPos" OCI-DEFINE-BY-POS)
 282     int
 283   (p0      (* t))
 284   (p1      (* t))
 285   (p2      (* t))
 286   (p3      unsigned-long)
 287   (p4      (* t))
 288   (p5      unsigned-long)
 289   (p6      unsigned-short)
 290   (p7      (* t))
 291   (p8      (* t))
 292   (p9      (* t))
 293   (p10     unsigned-long))
 294
 295 (def-oci-routine ("OCIStmtFetch" OCI-STMT-FETCH)
 296     int
 297   (stmthp       (* t))
 298   (errhp        (* t))
 299   (p2           unsigned-long)
 300   (p3           unsigned-short)
 301   (p4           unsigned-long))
 302
 303
 304 (def-oci-routine ("OCITransStart" OCI-TRANS-START)
 305   int
 306   (svchp       (* t))
 307   (errhp        (* t))
 308   (p2           unsigned-short)
 309   (p3           unsigned-short))
 310
 311 (def-oci-routine ("OCITransCommit" OCI-TRANS-COMMIT)
 312   int
 313   (svchp       (* t))
 314   (errhp        (* t))
 315   (p2           unsigned-short))
 316
 317 (def-oci-routine ("OCITransRollback" OCI-TRANS-ROLLBACK)
 318     int
 319   (svchp       (* t))
 320   (errhp        (* t))
 321   (p2           unsigned-short))
 322
 323