db-db2/db2-api.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          db2.lisp
   6 ;;;; Purpose:       Package definition for CLSQL Db2 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-db2)
  18
  19
  20 ;;
  21 ;; Opaque pointer types
  22 ;;
  23
  24 (uffi:def-foreign-type cli-handle :pointer-void)
  25 (uffi:def-foreign-type cli-pointer :pointer-void)
  26 (uffi:def-foreign-type cli-char :byte)
  27 (uffi:def-foreign-type cli-ulen :unsigned-int)
  28 (uffi:def-foreign-type cli-len :int)
  29 (uffi:def-foreign-type cli-smallint :short)
  30 (uffi:def-foreign-type cli-usmallint :unsigned-short)
  31
  32
  33 (defvar +null-void-pointer+ (uffi:make-null-pointer :void))
  34 (defvar +null-void-pointer-pointer+ (uffi:make-null-pointer :pointer-void))
  35
  36 ;;; Check an CLI return code for erroricity and signal a reasonably
  37 ;;; informative condition if so.
  38 ;;;
  39 ;;; ERRHP provides an error handle which can be used to find
  40 ;;; subconditions; if it's not provided, subcodes won't be checked.
  41 ;;;
  42 ;;; NULLS-OK says that a NULL-VALUE-RETURNED subcondition condition is
  43 ;;; normal and needn't cause any signal. An error handle is required
  44 ;;; to detect this subcondition, so it doesn't make sense to set ERRHP
  45 ;;; unless NULLS-OK is set.
  46
  47 (defmacro def-cli-routine ((c-cli-symbol lisp-cli-fn) c-return &rest c-parms)
  48   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
  49     `(let ((%lisp-cli-fn (uffi:def-function
  50                              (,c-cli-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-cli-fn))))
  51                              ,c-parms
  52                              :returning ,c-return)))
  53        (defun ,lisp-cli-fn (,@ll &key database nulls-ok)
  54          (let ((result (funcall %lisp-cli-fn ,@ll)))
  55            (case result
  56              (#.SQL_SUCCESS
  57               SQL_SUCCESS)
  58              (#.SQL_SUCCESS_WITH_INFO
  59               (format *standard-output* "sucess with info")
  60               SQL_SUCCESS)
  61              (#.SQL_ERROR
  62               (error 'sql-database-error
  63                      :error-id result
  64                      :message
  65                      (format nil "DB2 error" result)))
  66              (t
  67               (error 'sql-database-error
  68                      :message
  69                      (format nil "DB2 unknown error, code=~A" result)))))))))
  70
  71
  72 (defmacro def-raw-cli-routine
  73   ((c-cli-symbol lisp-cli-fn) c-return &rest c-parms)
  74   (let ((ll (mapcar (lambda (x) (declare (ignore x)) (gensym)) c-parms)))
  75     `(let ((%lisp-cli-fn (uffi:def-function (,c-cli-symbol ,(intern (concatenate 'string "%" (symbol-name lisp-cli-fn))))
  76                              ,c-parms
  77                            :returning ,c-return)))
  78        (defun ,lisp-cli-fn (,@ll &key database nulls-ok)
  79          (funcall %lisp-cli-fn ,@ll)))))
  80
  81
  82 (def-cli-routine ("SQLAllocHandle" sql-alloc-handle)
  83     :int
  84   (fHandleType cli-smallint)
  85   (hInput cli-handle)
  86   (phOuput (* cli-handle)))
  87
  88 (def-cli-routine ("SQLConnect" sql-connect)
  89     :int
  90   (hDb cli-handle)
  91   (server :cstring)
  92   (server-len cli-smallint)
  93   (user :cstring)
  94   (user-len cli-smallint)
  95   (password :cstring)
  96   (passwd-len cli-smallint))
  97
  98
  99 ;;; CLI Functions needed
 100 ;;;   SQLBindParameter
 101 ;;;   SQLExecDirect
 102 ;;;   SQLNumResultCols
 103 ;;;   SQLDescribeCol
 104 ;;;   SQLColAttribute
 105 ;;;   SQLRowCount
 106 ;;;   SQLBindCol
 107 ;;;   SQLFetch
 108 ;;;   SQLGetData
 109 ;;;   SQLEndTran
 110 ;;;   SQLFreeHandle
 111 ;;;   SQLDisconnect
 112 ;;;   SQLSetConnectAttr