X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql.lisp;h=671e3213be703c208b27053bcd81afb049b9a2f7;hb=78849aa930b4215a487b0a08492989196556efdd;hp=a031b8a569f9b3b05d92e043a04aa633ca4cdffa;hpb=c1293bd68aa6ab9ef67bb486b2edda24aea98fee;p=umlisp.git diff --git a/sql.lisp b/sql.lisp index a031b8a..671e321 100644 --- a/sql.lisp +++ b/sql.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; Name: sql.lisp ;;;; Purpose: Low-level SQL routines data for UMLisp -;;;; Programmer: Kevin M. Rosenberg +;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql.lisp,v 1.6 2002/10/18 03:57:39 kevin Exp $ +;;;; $Id: sql.lisp,v 1.11 2003/05/06 02:14:59 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -16,16 +16,14 @@ ;;;; 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-dsn* "KUMLS2002AC") -(defun umls-sql-dsn () - *umls-sql-dsn*) -(defun umls-sql-dsn! (dbname) +(defvar *umls-sql-db* "KUMLS2003AA") +(defun umls-sql-db () + *umls-sql-db*) +(defun umls-sql-db! (dbname) (sql-disconnect-pooled) - (setq *umls-sql-dsn* dbname)) + (setq *umls-sql-db* dbname)) (defvar *umls-sql-user* "secret") (defun umls-sql-user () @@ -57,8 +55,9 @@ (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)) - :database-type *umls-sql-type* :pool t)) + (clsql:connect + `(,(umls-sql-host) ,(umls-sql-db) ,(umls-sql-user) ,(umls-sql-passwd)) + :database-type *umls-sql-type* :pool t)) (defun sql-disconnect (conn) "Disconnect from UMLS database, but put connection back into pool" @@ -104,13 +103,3 @@ (defun mutex-sql-query (cmd &key (types :auto)) (with-mutex-sql (conn) (sql-query cmd conn :types types))) - -(defun find-usrl-all () - (let ((usrls '()) - (tuples (mutex-sql-query "select SAB,SRL from USRL order by SAB desc"))) - (dolist (tuple tuples) - (push (make-instance 'usrl :sab (nth 0 tuple) - :srl (ensure-integer (nth 1 tuple))) usrls)) - usrls)) - -