X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=sql.lisp;h=d2900d6d2a8bb40231d52cac24d6cc18b08e3c19;hp=e4900ad0734183afc91a701e8aa670f609ab18ef;hb=f4ea91e2cf0eb22db02498e54d1f75ef5dcd4239;hpb=a88c29f49f8db2cdef790ea152fef2d1dbbe0e64 diff --git a/sql.lisp b/sql.lisp index e4900ad..d2900d6 100644 --- a/sql.lisp +++ b/sql.lisp @@ -2,15 +2,15 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: sql.lisp -;;;; Purpose: Low-level SQL routines data for UMLisp -;;;; Author: 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.14 2003/08/08 09:06:06 kevin Exp $ +;;;; $Id$ ;;;; ;;;; This file, part of UMLisp, is -;;;; Copyright (c) 2000-2003 by Kevin M. Rosenberg, M.D. +;;;; Copyright (c) 2000-2006 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. @@ -19,24 +19,21 @@ (in-package #:umlisp) (defvar +umls-sql-map+ - '((:2002AD . "KUMLS2002AD") (:2003AA . "KUMLS2003AA") - (:2003AB . "KUMLS2003AB"))) -(defvar +default-umls-db+ "KUMLS2003AB") + '((:2004aa . "KUMLS2004AA") + (:2006ac . "KUMLS2006AC"))) +(defvar +default-umls-db+ :2006ac) (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) - (unless (eq db *umls-sql-db*) - (sql-disconnect-pooled)) (setq *umls-sql-db* db)) -(umls-sql-db! :2003AB) - (defvar *umls-sql-user* "secret") (defun umls-sql-user () *umls-sql-user*) @@ -68,7 +65,7 @@ (defun sql-connect () "Connect to UMLS database, automatically used pooled connections" (clsql:connect (list *umls-sql-host* (lookup-db-name *umls-sql-db*) - *umls-sql-user* *umls-sql-passwd*) + *umls-sql-user* *umls-sql-passwd*) :database-type *umls-sql-type* :pool t)) (defun sql-disconnect (conn) @@ -84,17 +81,17 @@ (progn ,@body) (when ,conn (clsql:disconnect :database ,conn))))) +(defun sql-query (cmd conn &key (result-types :auto)) + (clsql:query cmd :database conn :result-types result-types :field-names nil)) + +(defun sql-execute (cmd conn) + (clsql:execute-command cmd :database conn)) + (defun sql (stmt conn) (if (string-equal "SELECT" (subseq stmt 0 6)) (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-execute (cmd conn) - (clsql:execute-command cmd :database conn)) - (defun umls-sql (stmt) (check-type stmt string) (with-sql-connection (conn) @@ -112,6 +109,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)))