X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql.lisp;h=86f689328f0b2925819c5285874d993ebc6fe4fc;hb=aeade16272b79115d3f307906c7a3e9597137e97;hp=e7ee3a469814000d67ae3b8f8487a11b11ffaf74;hpb=bfdd5c9d3d66970759fcdbee5a51da2ca93ddf06;p=umlisp.git diff --git a/sql.lisp b/sql.lisp index e7ee3a4..86f6893 100644 --- a/sql.lisp +++ b/sql.lisp @@ -2,30 +2,38 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: sql.lisp -;;;; Purpose: Low-level SQL routines data for UMLisp -;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Apr 2000 +;;;; Name: sql.lisp +;;;; Purpose: Low-level SQL routines data for UMLisp +;;;; Author: Kevin M. Rosenberg +;;;; Created: Apr 2000 ;;;; -;;;; $Id: sql.lisp,v 1.3 2002/10/09 23:03:41 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2004 by Kevin M. Rosenberg, M.D. ;;;; ;;;; UMLisp users are granted the rights to distribute and use this software ;;;; as governed by the terms of the GNU General Public License. ;;;; ************************************************************************* -(in-package :umlisp) -(declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) +(in-package #:umlisp) +(defvar +umls-sql-map+ + '((:2002AD . "KUMLS2002AD") (:2003AA . "KUMLS2003AA") + (:2003AB . "KUMLS2003AB") (:2003AC . "KUMLS2003AC") + (:2004AA . "KUMLS2004AA"))) +(defvar +default-umls-db+ :2003AC) -(defvar *umls-sql-dsn* "KUMLS2002AC") -(defun umls-sql-dsn () - *umls-sql-dsn*) -(defun umls-sql-dsn! (dbname) - (sql-disconnect-pooled) - (setq *umls-sql-dsn* dbname)) + +(defun lookup-db-name (db) + (cdr (assoc (ensure-keyword db) +umls-sql-map+))) + +(defvar *umls-sql-db* +default-umls-db+) +(defun umls-sql-db () + *umls-sql-db*) + +(defun umls-sql-db! (db) + (setq *umls-sql-db* db)) (defvar *umls-sql-user* "secret") (defun umls-sql-user () @@ -57,7 +65,8 @@ (defun sql-connect () "Connect to UMLS database, automatically used pooled connections" - (clsql:connect `(,(umls-sql-host) ,(umls-sql-dsn) ,(umls-sql-user) ,(umls-sql-passwd)) + (clsql:connect (list *umls-sql-host* (lookup-db-name *umls-sql-db*) + *umls-sql-user* *umls-sql-passwd*) :database-type *umls-sql-type* :pool t)) (defun sql-disconnect (conn) @@ -78,8 +87,8 @@ (sql-query stmt conn) (sql-execute stmt conn))) -(defun sql-query (cmd conn &key (types :auto)) - (clsql:query cmd :database conn :types types)) +(defun sql-query (cmd conn &key (result-types :auto)) + (clsql:query cmd :database conn :result-types result-types)) (defun sql-execute (cmd conn) (clsql:execute-command cmd :database conn)) @@ -101,9 +110,6 @@ (with-mutex-sql (conn) (sql-execute cmd conn))) -(defun mutex-sql-query (cmd &key (types :auto)) +(defun mutex-sql-query (cmd &key (result-types :auto)) (with-mutex-sql (conn) - (sql-query cmd conn :types types))) - - - + (sql-query cmd conn :result-types result-types)))