X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql.lisp;h=671e3213be703c208b27053bcd81afb049b9a2f7;hb=5265bd2d2382c51c7bbef19c150466eb1afd58bd;hp=ef3be08ee04b4cd16cb7cf089fbab9a2dadb214f;hpb=48b70ea69d92b01f3e3795855581f8af8869b01f;p=umlisp.git diff --git a/sql.lisp b/sql.lisp index ef3be08..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.5 2002/10/16 16:05:23 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,25 +103,3 @@ (defun mutex-sql-query (cmd &key (types :auto)) (with-mutex-sql (conn) (sql-query cmd conn :types types))) - - - -(defun make-usrl () - (with-sql-connection (conn) - (sql-execute "drop table if exists USRL" conn) - (sql-execute "create table USRL (sab varchar(80), srl integer)" conn) - (dolist (tuple (mutex-sql-query "select distinct SAB,SRL from MRSO order by SAB asc")) - (sql-execute (format nil "insert into USRL (sab,srl) values ('~a',~d)" - (car tuple) (ensure-integer (cadr tuple))) - conn))) - (find-usrl-all)) - -(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)) - -