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