X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql.lisp;h=60db70661d991dfa295bd7ca624ce0b98c532c66;hb=baef3e3eba503d04fe6d19ac3087bf9d3dbc37b9;hp=ef3be08ee04b4cd16cb7cf089fbab9a2dadb214f;hpb=48b70ea69d92b01f3e3795855581f8af8869b01f;p=umlisp.git diff --git a/sql.lisp b/sql.lisp index ef3be08..60db706 100644 --- a/sql.lisp +++ b/sql.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: 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.9 2002/12/09 14:11:09 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -20,12 +20,12 @@ (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))) -(defvar *umls-sql-dsn* "KUMLS2002AC") -(defun umls-sql-dsn () - *umls-sql-dsn*) -(defun umls-sql-dsn! (dbname) +(defvar *umls-sql-db* "KUMLS2002AD") +(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,7 +57,7 @@ (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 `(,(umls-sql-host) ,(umls-sql-db) ,(umls-sql-user) ,(umls-sql-passwd)) :database-type *umls-sql-type* :pool t)) (defun sql-disconnect (conn) @@ -104,25 +104,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)) - -