From cd8b476663925be5a1ebbeb569a056e2e5b93aba Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 8 Oct 2002 22:13:41 +0000
Subject: [PATCH] r2952: *** empty log message ***

---
 README                               |  13 ++
 obj.lisp => classes.lisp             |  99 +-----------
 obj-composite.lisp => composite.lisp |   2 +-
 debian/docs                          |   1 +
 obj-sql.lisp => sql-classes.lisp     | 230 +--------------------------
 sql.lisp                             |   6 +-
 umlisp.asd                           |   8 +-
 7 files changed, 24 insertions(+), 335 deletions(-)
 create mode 100644 README
 rename obj.lisp => classes.lisp (81%)
 rename obj-composite.lisp => composite.lisp (98%)
 create mode 100644 debian/docs
 rename obj-sql.lisp => sql-classes.lisp (77%)

diff --git a/README b/README
new file mode 100644
index 0000000..9b75514
--- /dev/null
+++ b/README
@@ -0,0 +1,13 @@
+This is UMLisp - An object-oriented, SQL-based interface library to the 
+Unified Medical Language System.
+
+This is open-source software governed by the GNU General Public
+License included with the software in the file COPYING. It is
+Copyright (C) 2000-2002 by Kevin M. Rosenberg.
+
+No documentation is included with this product. Available
+documentation and support options are listed on the UMLisp support web
+site: http://umlisp.med-info.com/support/
+
+
+
diff --git a/obj.lisp b/classes.lisp
similarity index 81%
rename from obj.lisp
rename to classes.lisp
index f52a2b6..9a180ef 100644
--- a/obj.lisp
+++ b/classes.lisp
@@ -1,4 +1,4 @@
-;;; $Id: obj.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;; $Id: classes.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
 ;;;
 ;;; UMLS object defintions and printing routines
 
@@ -20,104 +20,7 @@
 	      (funcall (funcall (gu.ml::obj-data-value-func fmt) obj) obj))))))
 
 
-(defclass umlisp-user (umlsclass)
-  ((id :type fixnum :initarg :id :reader id)
-   (first-name :type string :initarg :first-name :reader first-name)
-   (last-name :type string :initarg :last-name :reader last-name)
-   (organization :type string :initarg :organization :reader organization)
-   (address1 :type string :initarg :address1 :reader address1)
-   (address2 :type string :initarg :address2 :reader address2)
-   (city :type string :initarg :city :reader city)
-   (state :type string :initarg :state :reader state)
-   (zip :type string :initarg :zip :reader zip)
-   (country :type string :initarg :country :reader country)
-   (licensed :type boolean :initarg :licensed :reader licensed)
-   (occupation :type string :initarg :occupation :reader occupation)
-   (email :type string :initarg :email :reader email)
-   (passwd :type string :initarg :passwd :reader passwd)  
-   (srl :type fixnum :initarg :srl :reader srl)
-   (timeout :type fixnum :initarg :timeout :reader timeout)
-   (maillist :type boolean :initarg :maillist :reader maillist)
-   (datetime-created :type string :initarg :datetime-created 
-		     :reader datetime-created)
-   (datetime-modified :type string :initarg :datetime-modified 
-		      :reader datetime-modified))
-   (:default-initargs 
-    :id nil :first-name nil :last-name nil :email nil :passwd nil :srl nil 
-    :organization nil :address1 nil :address2 nil :city nil :state nil 
-    :zip nil :country nil :licensed nil :occupation nil :maillist nil 
-    :timeout nil :datetime-created nil :datetime-modified nil)
-  (:metaclass ml-class)
-  (:title "UMLisp User")
-  (:fields 
-   (id :fixnum) (first-name :string) (last-name :string) (email :string) 
-   (occupation :string) (organization :string) (address1 :string) 
-   (address2 :string) (city :string) (state :string) (zip :string) 
-   (country :string) (licensed :boolean) (maillist :boolean) (srl :fixnum)
-   (timeout :fixnum) (datetime-created :string) (datetime-modified :string))
-  (:documentation "Class for UMLisp user database"))
-
-(defclass ustats (umlsclass)
-  ((name :type string :initarg :name :reader name)
-   (hits :type integer :initarg :hits :reader hits)
-   (srl :type fixnum :initarg :srl :reader srl))
-  (:metaclass ml-class)
-  (:default-initargs :name nil :hits nil :srl nil)
-  (:title "UMLS Statistic")
-  (:fields (name :string) (hits :commainteger) (srl :fixnum))
-  (:documentation "Custom Table: UMLS Database statistics."))
-  
-(defclass usrl (umlsclass)
-  ((sab :type string :initarg :sab :reader sab)
-   (srl :type integer :initarg :srl :reader srl))
-  (:metaclass ml-class)
-  (:default-initargs :sab nil :srl nil)
-  (:title "Source Restriction Level")
-  (:fields (sab :string) (srl :fixnum))
-  (:documentation "Custom Table: Source Restriction Level"))
-  
-(defclass bsab (umlsclass)
-  ((sab :type string :initarg :sab :reader sab)
-   (name :type string :initarg :name :reader name)
-   (hits :type fixnum :initarg :hits :reader hits))
-  (:metaclass ml-class)
-  (:default-initargs :sab nil :name nil :hits nil)
-  (:title "Source of Abbreviation")
-  (:fields (sab :string) (name :string) (hits :commainteger))
-  (:ref-fields (sab find-ustr-sab (("subobjects" "no"))))
-  (:documentation "Bonus SAB file"))
-  
-(defclass btty (umlsclass)
-  ((tty :type string :initarg :tty :reader tty)
-   (name :type string :initarg :name :reader name))
-  (:metaclass ml-class)
-  (:default-initargs :tty nil :name nil)
-  (:title "Bonus TTY")
-  (:fields (tty :string) (name :fixnum))
-  (:documentation "Bonus TTY file"))
-  
-(defclass brel (umlsclass)
-  ((sab :type string :initarg :sab :reader sab)
-   (sl :type string :initarg :sl :reader sl)
-   (rel :type string :initarg :rel :reader rel)
-   (rela :type string :initarg :rela :reader rela)
-   (hits :type fixnum :initarg :hits :reader hits))
-  (:metaclass ml-class)
-  (:default-initargs :sab nil :sl nil :rel nil :rela nil :hits nil)
-  (:title "Bonus REL")
-  (:fields 
-   (sab :string) (sl :string) (rel :string) (rela :string) (hits :commainteger))
-  (:documentation "Bonus REL file"))
 
-(defclass batn (umlsclass)
-  ((sab :type string :initarg :sab :reader sab)
-   (atn :type string :initarg :atn :reader atn)
-   (hits :type fixnum :initarg :hits :reader hits))
-  (:metaclass ml-class)
-  (:default-initargs :sab nil :atn nil)
-  (:title "Bonus ATN")
-  (:fields (sab :string) (atn :string) (hits :commaninteger))
-  (:documentation "Bonus ATN file"))
   
 (defclass urank (umlsclass)
   ((rank :type fixnum :initarg :rank :reader rank)
diff --git a/obj-composite.lisp b/composite.lisp
similarity index 98%
rename from obj-composite.lisp
rename to composite.lisp
index 61f62d5..d31c513 100644
--- a/obj-composite.lisp
+++ b/composite.lisp
@@ -1,4 +1,4 @@
-;;;; $Id: obj-composite.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; $Id: composite.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
 
 (in-package :umlisp)
 
diff --git a/debian/docs b/debian/docs
new file mode 100644
index 0000000..e845566
--- /dev/null
+++ b/debian/docs
@@ -0,0 +1 @@
+README
diff --git a/obj-sql.lisp b/sql-classes.lisp
similarity index 77%
rename from obj-sql.lisp
rename to sql-classes.lisp
index e05e096..e193f8b 100644
--- a/obj-sql.lisp
+++ b/sql-classes.lisp
@@ -1,4 +1,4 @@
-;;; $Id: obj-sql.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;; $Id: sql-classes.lisp,v 1.1 2002/10/08 22:08:56 kevin Exp $
  
 (in-package :umlisp)
 
@@ -10,13 +10,6 @@
 (defun current-srl! (srl)
   (setq *current-srl* srl))
 
-;;; Initializers
-
-(defun post-import-sql ()
-  (make-ustats)
-  (make-usrl)
-  (make-user-table)
-  #+pubmed (create-pmsearch-table))
 
 ;;; Accessors (read on demand)
 
@@ -526,45 +519,6 @@
 	      usats))
       (nreverse usats))))
 
-(defun find-bsab-sab (sab)
-    (gu:aif (car (mutex-sql-query 
-	       (format nil "select NAME,COUNT from BONUS_SAB where SAB='~a'" sab)))
-	 (make-instance 'bsab :sab sab :name (nth 0 gu::it) 
-			:hits (ensure-integer (nth 1 gu::it)))
-	 nil))
-
-(defun find-bsab-all ()
-  (let ((usabs '()))
-    (dolist (tuple (mutex-sql-query "select SAB,NAME,COUNT from BONUS_SAB"))
-      (push
-       (make-instance 'bsab :sab (nth 0 tuple) :name (nth 1 tuple)
-		      :hits (ensure-integer (nth 2 tuple)))
-       usabs))
-    (nreverse usabs)))
-	
-(defun find-btty-tty (tty)
-  (gu:aif (car (mutex-sql-query 
-	     (format nil "select NAME from BONUS_TTY where TTY='~a'" tty)))
-       (make-instance 'btty :tty tty :name (nth 0 gu::it))
-       nil))
-	
-(defun find-btty-all ()
-  (let ((uttys '()))
-    (dolist (tuple (mutex-sql-query "select TTY,NAME from BONUS_TTY"))
-      (push
-       (make-instance 'btty :tty (nth 0 tuple) :name (nth 1 tuple))
-       uttys))
-    (nreverse uttys)))
-	
-(defun find-brel-rel (rel)
-  (let ((brels '()))
-    (dolist (tuple (mutex-sql-query 
-		    (format nil "select SAB,SL,REL,RELA,COUNT from BONUS_REL where REL='~a'" rel)))
-      (push
-       (make-instance 'brel :sab (nth 0 tuple) :sl (nth 1 tuple) :rel (nth 2 tuple)
-		      :rela (nth 3 tuple)  :hits (ensure-integer (nth 4 tuple)))
-       brels))
-    (nreverse brels)))
 
 (defun find-pfstr-cui (cui)
   (caar (mutex-sql-query (format nil "select KPFSTR from MRCON where CUI=~d limit 1" cui))))
@@ -602,189 +556,7 @@
     (sort usty_freqs #'> :key #'usty_freq-freq)))
 	
 
-(defun make-user-table ()
-  (mutex-sql-execute "create table UMLISP_USERS (ID integer UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,FIRST_NAME varchar(20),LAST_NAME varchar(20),ORGANIZATION varchar(80),ADDRESS1 varchar(60),ADDRESS2 varchar(60),CITY varchar(30),STATE char(2),ZIP char(10),COUNTRY varchar(40),OCCUPATION varchar(120),EMAIL varchar(80),PASSWD varchar(20),MAILLIST char(1),LICENSED char(1),SRL integer,TIMEOUT integer,DATETIME_CREATED datetime,DATETIME_MODIFIED datetime)"))
-
-(defun find-umlisp-user-email (email)
-  (let ((tuple (car (mutex-sql-query 
-		     (format nil "select ID,FIRST_NAME,LAST_NAME,ORGANIZATION,ADDRESS1,ADDRESS2,CITY,STATE,ZIP,COUNTRY,OCCUPATION,LICENSED,MAILLIST,PASSWD,SRL,TIMEOUT,DATETIME_CREATED,DATETIME_MODIFIED from UMLISP_USERS where EMAIL='~a'" email)))))
-    (when tuple
-      (make-instance 'umlisp-user :email email
-		     :id (ensure-integer (nth 0 tuple))
-		     :first-name (nth 1 tuple)
-		     :last-name (nth 2 tuple)
-		     :organization (nth 3 tuple)
-		     :address1 (nth 4 tuple)
-		     :address2 (nth 5 tuple)
-		     :city (nth 6 tuple)
-		     :state (nth 7 tuple)
-		     :zip (nth 8 tuple)
-		     :country (nth 9 tuple)
-		     :occupation (nth 10 tuple)
-		     :licensed (if (string-equal "Y" (nth 11 tuple)) t nil)
-		     :maillist (if (string-equal "Y" (nth 12 tuple)) t nil)
-		     :passwd (nth 13 tuple)
-		     :srl (ensure-integer (nth 14 tuple))
-		     :timeout (ensure-integer (nth 15 tuple))
-		     :datetime-created (nth 16 tuple)
-		     :datetime-modified (nth 17 tuple)))))
-
-(defun find-umlisp-user-all ()
-  (let ((users '()))
-    (dolist (email (find-umlisp-user-all-email))
-      (push (find-umlisp-user-email email) users))
-    (nreverse users)))
-
-(defun find-umlisp-user-all-email ()
-  (let ((emails '()))
-    (dolist (tuple (mutex-sql-query "select EMAIL from UMLISP_USERS"))
-      (push (car tuple) emails))
-    (nreverse emails)))
-
-(defun find-umlisp-user-announce-email ()
-  (let ((emails '()))
-    (dolist (tuple (mutex-sql-query 
-		    "select EMAIL from UMLISP_USERS where MAILLIST='Y'"))
-      (push (car tuple) emails))
-    (nreverse emails)))
-
-(defun add-umlisp-user (user)
-  (if (typep user 'umlisp-user)
-      (progn
-	(mutex-sql-execute
-	 (format nil "insert into UMLISP_USERS (FIRST_NAME,LAST_NAME,ORGANIZATION,ADDRESS1,ADDRESS2,CITY,STATE,ZIP,COUNTRY,OCCUPATION,LICENSED,MAILLIST,EMAIL,PASSWD,SRL,TIMEOUT,DATETIME_CREATED,DATETIME_MODIFIED) values ('~a','~a','~a','~a','~a','~a','~a','~a','~a','~a','~a','~a','~a','~a',~d,~d,NOW(),NOW())" 
-		 (first-name user) (last-name user)
-		 (organization user)
-		 (address1 user) (address2 user)
-		 (city user) (state user)
-		 (zip user) (country user) (occupation user) 
-		 (if (licensed user) #\Y #\N)
-		 (if (maillist user) #\Y #\N)
-		 (email user) 
-		 (passwd user) (srl user)
-		 (timeout user)))
-	(let ((read-user (find-umlisp-user-email (email user))))
-	  (setf (slot-value user 'id) (id read-user)
-		(slot-value user 'datetime-created) (datetime-created read-user)
-		(slot-value user 'datetime-modified) (datetime-modified read-user)))
-	t)
-    nil))
 
-(defun umlisp-user-verify-passwd (user passwd)
-  (when user
-    (string-equal passwd (passwd user))))
-
-(defun umlisp-user-set-srl (email srl)
-  (when (and (integerp srl) (find-umlisp-user-email email))
-    (mutex-sql-execute 
-     (format nil "update UMLISP_USERS set SRL=~d,DATETIME_MODIFIED=NOW() where EMAIL='~a'" srl email))
-    srl))
-
-(defun make-ustats ()
-  (with-sql-connection (conn)
-    (sql-execute "drop table if exists USTATS" conn)
-    (sql-execute "create table USTATS (NAME varchar(160), COUNT bigint, SRL integer)" conn)
-    
-    (dotimes (srl 4)
-      (insert-ustats-count conn "Concept Count" "MRCON" "distinct CUI" "KCUILRL" srl)
-      (insert-ustats-count conn "Term Count" "MRCON" "distinct KCUILUI" "KCUILRL" srl)
-      (insert-ustats-count conn "Distinct Term Count" "MRCON" "distinct LUI" "KLUILRL" srl)
-      (insert-ustats-count conn "String Count" "MRCON" "*" "LRL" srl)
-      (insert-ustats-count conn "Distinct String Count" "MRCON" "distinct SUI" "LRL" srl)
-      (insert-ustats-count conn "Associated Expression Count" "MRATX" "*" "KSRL" srl)
-      (insert-ustats-count conn "Context Count" "MRCXT" "*" "KSRL" srl)
-      (insert-ustats-count conn "Co-occuring Concept Count" "MRCOC" "*" "KLRL" srl)
-      (insert-ustats-count conn "Definition Count" "MRDEF" "*" "KSRL" srl)
-      (insert-ustats-count conn "Locator Count" "MRLO" "*" "KLRL" srl)
-      (insert-ustats-count conn "Rank Count" "MRRANK" "*" "KSRL" srl)
-      (insert-ustats-count conn "Relationship Count" "MRREL" "*" "KSRL" srl)
-      (insert-ustats-count conn "Semantic Type Count" "MRSTY" "*" "KLRL" srl)
-      (insert-ustats-count conn "Simple Attribute Count" "MRSAT" "*" "KSRL" srl)
-      (insert-ustats-count conn "Source Count" "MRSO" "*" "SRL" srl)
-      (insert-ustats-count conn "Word Index Count" "MRXW_ENG" "*" "KLRL" srl)
-      (insert-ustats-count conn "Normalized Word Index Count" "MRXNW_ENG" "*" "KLRL" srl)
-      (insert-ustats-count conn "Normalized String Index Count" "MRXNS_ENG" "*" "KLRL" srl)
-      (insert-ustats-count conn "Bonus Attribute Name Count" "BONUS_ATN" "*" nil srl)
-      (insert-ustats-count conn "Bonus Relationship Count" "BONUS_REL" "*" nil srl)
-      (insert-ustats-count conn "Bonus Source Abbreviation Count" "BONUS_SAB" "*" nil srl)
-      (insert-ustats-count conn "Bonus Term Type Count" "BONUS_TTY" "*" nil srl))
-    (sql-execute "create index USTATS_SRL on USTATS (SRL)" conn))
-  (find-ustats-all))
-
-(defun insert-ustats-count (conn name table count-variable srl-control srl)
-  (insert-ustats conn name (find-count-table conn table srl count-variable srl-control) srl))
-
-(defun find-count-table (conn table srl count-variable srl-control)
-  (cond
-   ((stringp srl-control)
-    (ensure-integer 
-     (caar (sql-query (format nil "select count(~a) from ~a where ~a <= ~d" 
-			      count-variable table srl-control srl)
-		      conn))))
-   ((null srl-control)
-    (ensure-integer
-     (caar (sql-query (format nil "select count(~a) from ~a" 
-			      count-variable table )
-		      conn))))
-   (t
-    (error "Unknown srl-control")
-    0)))
-
-(defun insert-ustats (conn name count srl)
-  (sql-execute (format nil "insert into USTATS (name,count,srl) values ('~a',~d,~d)" 
-		       name count (if srl srl 3)) 
-	       conn))
-  
-(defun find-ustats-all (&key (srl *current-srl*))
-  (let ((ustats '())
-	(ls "select NAME,COUNT,SRL from USTATS"))
-    (when srl
-      (string-append ls (format nil " where SRL=~d" srl)))
-    (string-append ls " order by NAME asc")
-    (dolist (tuple (mutex-sql-query ls))
-      (push (make-instance 'ustats :name (nth 0 tuple)
-			   :hits (ensure-integer (nth 1 tuple))
-			   :srl (ensure-integer (nth 2 tuple)))
-	    ustats))
-    (nreverse ustats)))
-
-(defun find-ustats-srl (srl)
-  (let ((ustats '()))
-    (dolist (tuple (mutex-sql-query
-		    (format nil "select NAME,COUNT from USTATS where SRL=~d order by NAME asc" srl)))
-      (push (make-instance 'ustats :name (nth 0 tuple)
-			   :hits (ensure-integer (nth 1 tuple))
-			   :srl srl)
-	    ustats))
-    (nreverse ustats)))
-
-(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)) ;; already reversed by sql
-
-(defun find-usrl_freq-all ()
-  (let ((freqs '()))
-    (dolist (usrl (find-usrl-all))
-      (let ((freq (ensure-integer 
-		   (caar (mutex-sql-query 
-			  (format nil "select count(*) from MRSO where SAB='~a'" 
-				  (sab usrl)))))))
-	(push (make-instance 'usrl_freq :usrl usrl :freq freq) freqs)))
-    (sort freqs #'> :key #'usrl_freq-freq)))
 
 (defun find-cui-max ()
   (let ((cui (caar (mutex-sql-query "select max(CUI) from MRCON"))))
diff --git a/sql.lisp b/sql.lisp
index 3a71e36..7e5ce88 100644
--- a/sql.lisp
+++ b/sql.lisp
@@ -1,7 +1,7 @@
 ;;;;  -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Pkg: umlisp -*-
 ;; SQL/UMLS database Layer over database backend
 ;; Copyright (c) 2001 Kevin M. Rosenberg, M.D.
-;; $Id: sql.lisp,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;; $Id: sql.lisp,v 1.2 2002/10/08 22:13:41 kevin Exp $
 
 (in-package :umlisp)
 
@@ -14,14 +14,14 @@
   (sql-disconnect-pooled)
   (setq *umls-sql-dsn* dbname))
 
-(defvar *umls-sql-user* "webumls")
+(defvar *umls-sql-user* "secret")
 (defun umls-sql-user ()
   *umls-sql-user*)
 (defun umls-sql-user! (u)
   (sql-disconnect-pooled)
   (setq *umls-sql-user* u))
 
-(defvar *umls-sql-passwd* "webumls")
+(defvar *umls-sql-passwd* "secret")
 (defun umls-sql-passwd ()
   *umls-sql-passwd*)
 (defun umls-sql-passwd! (p)
diff --git a/umlisp.asd b/umlisp.asd
index 368ce84..b83899c 100644
--- a/umlisp.asd
+++ b/umlisp.asd
@@ -1,5 +1,5 @@
 ;;;;  -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; $Id: umlisp.asd,v 1.1 2002/10/05 20:17:14 kevin Exp $
+;;;; $Id: umlisp.asd,v 1.2 2002/10/08 22:08:56 kevin Exp $
 
 (in-package :asdf)
 
@@ -12,7 +12,7 @@
       (:file "parse-macros"  :depends-on ("sql"))
       (:file "parse-2002"  :depends-on ("parse-macros"))
       (:file "parse-common"  :depends-on ("parse-2002"))
-      (:file "obj" :depends-on ("utils"))
-      (:file "obj-sql" :depends-on ("obj" "sql"))
-      (:file "obj-composite" :depends-on ("obj-sql"))))
+      (:file "classes" :depends-on ("utils"))
+      (:file "sql-classes" :depends-on ("classes" "sql"))
+      (:file "composite" :depends-on ("sql-classes"))))
 
-- 
2.34.1