1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: db2-sql.lisp
9 ;;;; This file is part of CLSQL.
11 ;;;; CLSQL users are granted the rights to distribute and use this software
12 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
13 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
14 ;;;; *************************************************************************
16 (in-package #:clsql-db2
)
18 (defmethod database-initialize-database-type ((database-type (eql :db2
)))
21 (defclass db2-database
(database)
22 ((henv :initform nil
:allocation
:class
:initarg
:henv
:accessor henv
)
23 (hdbc :initform nil
:initarg
:hdbc
:accessor hdbc
)))
26 (defmethod database-name-from-spec (connection-spec
27 (database-type (eql :db2
)))
28 (check-connection-spec connection-spec database-type
(dsn user password
))
29 (destructuring-bind (dsn user password
) connection-spec
30 (declare (ignore password
))
31 (concatenate 'string dsn
"/" user
)))
33 (defmethod database-connect (connection-spec (database-type (eql :db2
)))
34 (check-connection-spec connection-spec database-type
(dsn user password
))
35 (destructuring-bind (server user password
) connection-spec
37 (let ((db (make-instance 'db2-database
38 :name
(database-name-from-spec connection-spec
:db2
)
39 :database-type
:db2
)))
40 (db2-connect db server user password
)
42 (error () ;; Init or Connect failed
43 (error 'sql-connection-error
44 :database-type database-type
45 :connection-spec connection-spec
46 :message
"Connection failed")))))
51 (uffi:def-type handle-type cli-handle
)
52 (uffi:def-type handle-ptr-type
(* cli-handle
))
54 (defmacro deref-vp
(foreign-object)
55 `(the handle-type
(uffi:deref-pointer
(the handle-ptr-type
,foreign-object
) cli-handle
)))
57 (defun db2-connect (db server user password
)
58 (let ((henv (uffi:allocate-foreign-object
'cli-handle
))
59 (hdbc (uffi:allocate-foreign-object
'cli-handle
)))
60 (sql-alloc-handle SQL_HANDLE_ENV SQL_NULL_HANDLE henv
)
61 (setf (slot-value db
'henv
) henv
)
62 (setf (slot-value db
'hdbc
) hdbc
)
64 (sql-alloc-handle SQL_HANDLE_DBC
(deref-vp henv
) hdbc
)
65 (uffi:with-cstrings
((native-server server
)
67 (native-password password
))
68 (sql-connect (deref-vp hdbc
)
71 native-password SQL_NTS
)))