X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=sql-create.lisp;fp=sql-create.lisp;h=0000000000000000000000000000000000000000;hb=3199369942d2e5ab4f5b060c2c6b655caf505944;hp=49f550e9b99bf7f36c26bffdd1ebd770d50825fb;hpb=7e088e3bca94e4cba5a00f3c3734db4ea57f4e2f;p=umlisp.git

diff --git a/sql-create.lisp b/sql-create.lisp
deleted file mode 100644
index 49f550e..0000000
--- a/sql-create.lisp
+++ /dev/null
@@ -1,312 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: umlisp -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          sql-create
-;;;; Purpose:       Create SQL database for UMLisp
-;;;; Author:        Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: sql-create.lisp,v 1.21 2003/05/06 08:15:47 kevin Exp $
-;;;;
-;;;; This file, part of UMLisp, is
-;;;;    Copyright (c) 2000-2002 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.
-;;;; *************************************************************************
-
-(in-package :umlisp)
-
-(eval-when (:compile-toplevel)
-  (declaim (optimize (speed 3) (safety 1) (compilation-speed 0) (debug 3))))
-
-(defun create-table-cmd (file)
-  "Return sql command to create a table"
-  (let ((col-func 
-	 (lambda (c) 
-	   (let ((sqltype (sqltype c)))
-	     (concatenate 'string
-			  (col c)
-			  " "
-			  (if (or (string-equal sqltype "VARCHAR")
-				  (string-equal sqltype "CHAR"))
-			      (format nil "~a (~a)" sqltype (cmax c))
-			      sqltype))))))
-    (format nil "CREATE TABLE ~a (~{~a~^,~})" (table file)
-	    (mapcar col-func (ucols-for-ufile file)))))
-
-(defun create-custom-table-cmd (tablename sql-cmd)
-  "Return SQL command to create a custom table"
-  (format nil "CREATE TABLE ~a AS ~a;" tablename sql-cmd))
-
-(defun insert-col-value (col value)
-  (if (null (parse-fun col)) 
-      value
-      (format nil "~A" (funcall (parse-fun col) value))))
-
-(defun insert-values-cmd (file values)
-  "Return sql insert command for a row of values"  
-  (let ((insert-func
-	 (lambda (col value)
-	   (let ((q (quotechar col)))
-	     (concatenate 'string q (insert-col-value col value) q)))))
-    (format
-     nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
-     (table file)
-     (fields file)
-     (concat-separated-strings
-      "," 
-      (mapcar insert-func (remove-custom-cols (ucols file)) values)
-      (custom-col-values (custom-ucols-for-file file) values t)))))
-
-
-(defun custom-col-value (col values doquote)
-  (let ((custom-value (funcall (custom-value-fun col) values)))
-    (if custom-value
-	(if doquote
-	    (let ((q (quotechar col)))
-	      (concatenate 'string q (escape-backslashes custom-value) q))
-	    (escape-backslashes custom-value))
-	"")))
-
-(defun custom-col-values (ucols values doquote)
-  "Returns a list of string column values for SQL inserts for custom columns"
-  (loop for col in ucols collect (custom-col-value col values doquote)))
-
-(defun remove-custom-cols (cols)
-  "Remove custom cols from a list col umls-cols"
-  (remove-if #'custom-value-fun cols))
-
-(defun find-custom-cols-for-filename (filename)
-  (remove-if-not (lambda (x) (string-equal filename (car x))) +custom-cols+))
-
-(defun find-custom-col (filename col)
-  (find-if (lambda (x) (and (string-equal filename (car x))
-			    (string-equal col (cadr x)))) +custom-cols+))
-
-(defun custom-colnames-for-filename (filename)
-  (mapcar #'cadr (find-custom-cols-for-filename filename)))
-
-(defun custom-ucols-for-file (file)
-  (remove-if-not #'custom-value-fun (ucols file)))
-
-(defun noneng-lang-index-files ()
-  (remove-if-not
-   (lambda (f) (and (> (length (fil f)) 4)
-		    (string-equal (fil f) "MRXW." :end1 5) 
-		    (not (string-equal (fil f) "MRXW.ENG"))
-		    (not (string-equal (fil f) "MRXW.NONENG"))))
-   *umls-files*))
-
-;;; SQL Command Functions
-
-(defun create-index-cmd (colname tablename length)
-  "Return sql create index command"
-  (format nil "CREATE INDEX ~a ON ~a (~a ~a)"
-	  (concatenate 'string tablename "_" colname "_X")
-	  tablename colname
-	  (if (integerp length) (format nil "(~d)" length) "")))
-
-(defun create-all-tables-cmdfile ()
-  "Return sql commands to create all tables. Not need for automated SQL import"
-  (mapcar (lambda (f) (format nil "~a~%~%" (create-table-cmd f))) *umls-files*))
-
-;; SQL Execution functions
-
-(defun sql-drop-tables (conn)
-  "SQL Databases: drop all tables"
-  (dolist (file *umls-files*)
-    (ignore-errors 
-      (sql-execute (format nil "DROP TABLE ~a" (table file)) conn))))
-
-(defun sql-create-tables (conn)
-  "SQL Databases: create all tables" 
-  (dolist (file *umls-files*)
-    (sql-execute (create-table-cmd file) conn)))
-
-(defun sql-create-custom-tables (conn)
-  "SQL Databases: create all custom tables"
-  (dolist (ct +custom-tables+)
-    (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn)))
-  
-(defun sql-insert-values (conn file)
-  "SQL Databases: inserts all values for a file"  
-  (with-umls-file (line (fil file))
-    (sql-execute (insert-values-cmd file line) conn)))
-
-(defun sql-insert-all-values (conn)
-  "SQL Databases: inserts all values for all files"  
-  (dolist (file *umls-files*)
-    (sql-insert-values conn file)))
-
-(defun sql-create-indexes (conn &optional (indexes +index-cols+))
-  "SQL Databases: create all indexes"
-  (dolist (idx indexes)
-    (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn))) 
-
-(defun make-usrl (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)))
-
-(defun sql-create-special-tables (conn)
-  (make-usrl conn))
-
-(defun create-umls-db-by-insert ()
-  "SQL Databases: initializes entire database via SQL insert commands"
-  (init-umls)
-  (init-hash-table)
-  (with-sql-connection (conn)
-    (sql-drop-tables conn)
-    (sql-create-tables conn)
-    (sql-insert-all-values conn)
-    (sql-create-indexes conn)
-    (sql-create-custom-tables conn)
-    (sql-create-indexes conn +custom-index-cols+)
-    (sql-create-special-tables conn)))
-
-(defun create-umls-db (&optional (extension ".trans") 
-		       (copy-cmd #'mysql-copy-cmd))
-  "SQL Databases: initializes entire database via SQL copy commands. 
-This is much faster that using create-umls-db-insert."
-  (init-umls)
-  (init-hash-table)
-  (translate-all-files extension)
-  (with-sql-connection (conn)
-    (sql-drop-tables conn)
-    (sql-create-tables conn)
-    (map 'nil 
-     #'(lambda (file) (sql-execute (funcall copy-cmd file extension) conn)) 
-     *umls-files*)
-    (sql-create-indexes conn)
-    (sql-create-custom-tables conn)
-    (sql-create-indexes conn +custom-index-cols+)
-    (sql-create-special-tables conn)))
-
-(defun translate-all-files (&optional (extension ".trans"))
-  "Copy translated files and return postgresql copy commands to import"
-  (make-noneng-index-file extension)
-  (dolist (f *umls-files*) (translate-umls-file f extension)))
-
-(defun translate-umls-file (file extension)
-  "Translate a umls file into a format suitable for sql copy cmd"
-  (translate-files file extension (list file)))
-
-(defun make-noneng-index-file (extension)
-  "Make non-english index file"
-  (translate-files (find-ufile "MRXW.NONENG")
-		   extension (noneng-lang-index-files)))
-
-(defun translate-files (out-ufile extension input-ufiles)
-  "Translate a umls file into a format suitable for sql copy cmd"
-  (let ((output-path (umls-pathname (fil out-ufile) extension)))
-    (if (probe-file output-path)
-	(format t "File ~A already exists: skipping~%" output-path)
-      (with-open-file (ostream output-path :direction :output)
-	(dolist (input-ufile input-ufiles)
-	  (with-umls-file (line (fil input-ufile))
-	    (translate-line out-ufile line ostream)
-	    (princ #\newline ostream)))))))
-
-(defun pg-copy-cmd (file extension)
-  "Return postgresql copy statement for a file"  
-  (format
-   nil "COPY ~a FROM '~a' using delimiters '|' with null as ''"
-   (table file) (umls-pathname (fil file) extension)))
-
-(defun mysql-copy-cmd (file extension)
-  "Return mysql copy statement for a file"  
-  (format
-   nil
-   "LOAD DATA LOCAL INFILE \"~a\" INTO TABLE ~a FIELDS TERMINATED BY \"|\""
-   (umls-pathname (fil file) extension) (table file)))
-
-(defun col-value (col value)
-  (if (eq (datatype col) 'sql-u)
-      (let ((ui (parse-ui value "")))
-	(if (stringp ui)
-	    ui
-	  (write-to-string ui)))
-    (escape-backslashes value)))
-
-(defun translate-line (file line strm)
-  "Translate a single line for sql output"
-  (print-separated-strings
-   strm "|" 
-   (mapcar #'col-value (remove-custom-cols (ucols file)) line)
-   (custom-col-values (custom-ucols-for-file file) line nil)))
-   
-
-;;; Routines for analyzing cost of fixed size storage
-
-
-(defun umls-fixed-size-waste ()
-  "Display storage waste if using all fixed size storage"
-  (let ((totalwaste 0)
-	(totalunavoidable 0)
-	(totalavoidable 0)
-	(unavoidable '())
-	(avoidable '()))
-    (dolist (file *umls-files*)
-      (dolist (col (ucols file))
-	(let* ((avwaste (- (cmax col) (av col)))
-	       (cwaste (* avwaste (rws file))))
-	  (when (plusp cwaste)
-	    (if (<= avwaste 6)
-		(progn
-		  (incf totalunavoidable cwaste)
-		  (push (list (fil file) (col col)
-			      avwaste cwaste)
-			unavoidable))
-		(progn
-		  (incf totalavoidable cwaste)
-		  (push (list (fil file) (col col)
-			      avwaste cwaste)
-			avoidable)))
-	    (incf totalwaste cwaste)))))
-    (values totalwaste totalavoidable totalunavoidable
-	    (nreverse avoidable) (nreverse unavoidable))))
-
-(defun display-waste ()
-  (unless *umls-files*
-    (init-umls))
-  (multiple-value-bind (tw ta tu al ul) (umls-fixed-size-waste)
-    (format t "Total waste: ~d~%" tw)
-    (format t "Total avoidable: ~d~%" ta)
-    (format t "Total unavoidable: ~d~%" tu)
-    (format t "Avoidable:~%")
-    (dolist (w al)
-      (format t "  (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
-    (format t "Unavoidable:~%")
-    (dolist (w ul)
-      (format t "  (~a,~a): ~a,~a~%" (car w) (cadr w) (caddr w) (cadddr w)))
-    ))
-
-(defun max-umls-field ()
-  "Return length of longest field"
-  (unless *umls-files*
-    (init-umls))
-  (let ((max 0))
-    (declare (fixnum max))
-    (dolist (col *umls-cols*)
-      (when (> (cmax col) max)
-	(setq max (cmax col))))
-    max))
-
-(defun max-umls-row ()
-  "Return length of longest row"
-  (unless *umls-files*
-    (init-umls))
-  (let ((rowsizes '()))
-    (dolist (file *umls-files*)
-      (let ((row 0)
-	    (fields (ucols file)))
-	(dolist (field fields)
-	  (incf row (1+ (cmax field))))
-	(push row rowsizes)))
-    (car (sort rowsizes #'>))))