1 ;;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Pkg: umlisp -*-
2 ;; SQL/UMLS database Layer over database backend
3 ;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
4 ;; $Id: sql.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
8 (declaim (optimize (speed 1) (safety 3)))
10 (defvar *umls-sql-dsn* "KUMLS2002AC")
11 (defun umls-sql-dsn ()
13 (defun umls-sql-dsn! (dbname)
14 (sql-disconnect-pooled)
15 (setq *umls-sql-dsn* dbname))
17 (defvar *umls-sql-user* "webumls")
18 (defun umls-sql-user ()
20 (defun umls-sql-user! (u)
21 (sql-disconnect-pooled)
22 (setq *umls-sql-user* u))
24 (defvar *umls-sql-passwd* "webumls")
25 (defun umls-sql-passwd ()
27 (defun umls-sql-passwd! (p)
28 (sql-disconnect-pooled)
29 (setq *umls-sql-passwd* p))
31 (defvar *umls-sql-host* "localhost")
32 (defun umls-sql-host ()
34 (defun umls-sql-host! (h)
35 (sql-disconnect-pooled)
36 (setq *umls-sql-host* h))
38 (defvar *umls-sql-type* :mysql)
39 (defun umls-sql-type ()
41 (defun umls-sql-type! (h)
42 (sql-disconnect-pooled)
43 (setq *umls-sql-type* h))
46 "Connect to UMLS database, automatically used pooled connections"
47 (clsql:connect `(,(umls-sql-host) ,(umls-sql-dsn) ,(umls-sql-user) ,(umls-sql-passwd))
48 :database-type *umls-sql-type* :pool t))
50 (defun sql-disconnect (conn)
51 "Disconnect from UMLS database, but put connection back into pool"
52 (clsql:disconnect :database conn))
54 (defun sql-disconnect-pooled ()
55 (clsql:disconnect-pooled))
57 (defmacro with-sql-connection ((conn) &body body)
58 `(let ((,conn (sql-connect)))
61 (when ,conn (clsql:disconnect :database ,conn)))))
63 (defun sql (stmt conn)
64 (if (string-equal "SELECT" (subseq stmt 0 6))
66 (sql-execute stmt conn)))
68 (defun sql-query (cmd conn &key (types :auto))
69 (clsql:query cmd :database conn :types types))
71 (defun sql-execute (cmd conn)
72 (clsql:execute-command cmd :database conn))
74 (defun umls-sql (stmt)
75 (check-type stmt string)
76 (with-sql-connection (conn)
79 ;;; Pool of open connections
81 (defmacro with-mutex-sql ((conn) &body body)
82 `(let ((,conn (sql-connect)))
85 (when ,conn (sql-disconnect ,conn)))))
87 (defun mutex-sql-execute (cmd)
88 (with-mutex-sql (conn)
89 (sql-execute cmd conn)))
91 (defun mutex-sql-query (cmd &key (types :auto))
92 (with-mutex-sql (conn)
93 (sql-query cmd conn :types types)))