X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=parse-common.lisp;h=6b170e61fc8473ffcc9b3457df094886e34ec1a8;hb=c1293bd68aa6ab9ef67bb486b2edda24aea98fee;hp=4c13a526f45f5a179ac102bc0c4de0f753843291;hpb=c695945cbb26d9c98afeab52c2084fe548e8f9b0;p=umlisp.git

diff --git a/parse-common.lisp b/parse-common.lisp
index 4c13a52..6b170e6 100644
--- a/parse-common.lisp
+++ b/parse-common.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: parse-common.lisp,v 1.2 2002/10/09 23:03:41 kevin Exp $
+;;;; $Id: parse-common.lisp,v 1.3 2002/10/18 03:57:39 kevin Exp $
 ;;;;
 ;;;; This file, part of UMLisp, is
 ;;;;    Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
@@ -178,232 +178,7 @@ Currently, these are the LEX and NET files."
 	    (umls-file-fields file))))
 
 
-;; SQL command functions
-
-(defun create-table-cmd (file)
-"Return sql command to create a table"
-  (let ((col-func 
-	 (lambda (c) 
-	   (let ((sqltype (umls-col-sqltype c)))
-	     (concatenate 'string (umls-col-col c)
-		" "
-		(if (or (string-equal sqltype "VARCHAR")
-			(string-equal sqltype "CHAR"))
-		     (format nil "~a (~a)" sqltype (umls-col-max c))
-		  sqltype)
-		",")))))
-    (format nil "CREATE TABLE ~a (~a)" (umls-file-table file)
-	    (string-trim-last-character
-	     (mapcar-append-string col-func (umls-cols-for-umls-file 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-values-cmd (file values)
-"Return sql insert command for a row of values"  
-  (let ((insert-func
-	 (lambda (col value)
-	   (concatenate
-	    'string
-	    (umls-col-quotechar col)
-	    (if (null (umls-col-parsefunc col)) 
-		value
-	      (format nil "~A" (funcall (umls-col-parsefunc col) value)))
-	    (umls-col-quotechar col)
-	    ","))))
-    (format
-     nil "INSERT INTO ~a (~a) VALUES (~a)"
-     (umls-file-table file)
-     (string-trim-last-character
-      (mapcar-append-string (lambda (c) (concatenate 'string c ","))
-			    (umls-file-fields file)))
-     (string-trim-last-character
-      (concatenate 'string
-	(mapcar2-append-string insert-func
-			       (remove-custom-cols (umls-file-colstructs file)) 
-			       values)
-	(custom-col-values (custom-colstructs-for-file file) values "," t)))
-     )))
-
-(defun custom-col-values (colstructs values delim doquote)
-  "Returns string of column values for SQL inserts for custom columns"
-  (let ((result ""))
-    (dolist (col colstructs)
-      (let* ((func (umls-col-custom-value-func col))
-	     (custom-value (funcall func values)))
-	(string-append result 
-		       (if doquote (umls-col-quotechar col))
-		       (escape-backslashes custom-value)
-		       (if doquote (umls-col-quotechar col))
-		       delim)))
-    result))
-
-(defun remove-custom-cols (cols)
-  "Remove custom cols from a list col umls-cols"
-  (remove-if #'umls-col-custom-value-func 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-colstructs-for-file (file)
-  (remove-if-not #'umls-col-custom-value-func (umls-file-colstructs file)))
-
-(defun noneng-lang-index-files ()
-  (remove-if-not (lambda (f) (and (> (length (umls-file-fil f)) 4)
-			      (string-equal (umls-file-fil f) "MRXW." :end1 5) 
-			      (not (string-equal (umls-file-fil f) "MRXW.ENG"))
-			      (not (string-equal (umls-file-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"
-  (mapcar
-   (lambda (file)
-     (ignore-errors 
-      (sql-execute (format nil "DROP TABLE ~a" (umls-file-table file)) conn)))
-   *umls-files*))
-
-(defun sql-create-tables (conn)
-"SQL Databases: create all tables" 
-  (mapcar (lambda (file) (sql-execute (create-table-cmd file) conn)) *umls-files*))
-
-(defun sql-create-custom-tables (conn)
-"SQL Databases: create all custom tables"
-  (mapcar (lambda (ct)
-     (sql-execute (create-custom-table-cmd (car ct) (cadr ct)) conn))
-   +custom-tables+))
-  
-(defun sql-insert-values (conn file)
-"SQL Databases: inserts all values for a file"  
-  (with-umls-file (line (umls-file-fil file))
-		  (sql-execute (insert-values-cmd file line) conn)))
-
-(defun sql-insert-all-values (conn)
-"SQL Databases: inserts all values for all files"  
-  (mapcar (lambda (file) (sql-insert-values conn file)) *umls-files*))
-
-(defun sql-create-indexes (conn &optional (indexes +index-cols+))
-"SQL Databases: create all indexes"
-(mapcar 
- (lambda (idx) 
-   (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn)) 
- indexes))
-
-(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+)))
-
-(defun create-umls-db (&optional (extension ".trans") 
-				 (copy-cmd #'mysql-copy-cmd))
-  "SQL Databases: initializes entire database via SQL copy commands"
-  (init-umls)
-  (init-hash-table)
-  (translate-all-files extension)
-  (with-sql-connection (conn)
-    (sql-drop-tables conn)
-    (sql-create-tables conn)
-    (mapcar 
-     #'(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+)))
-
-(defun translate-all-files (&optional (extension ".trans"))
-"Copy translated files and return postgresql copy commands to import"
-  (make-noneng-index-file extension)
-  (mapcar (lambda (f) (translate-file f extension)) *umls-files*))
-
-(defun translate-file (file extension)
-  "Translate a umls file into a format suitable for sql copy cmd"
-  (let ((path (umls-pathname (umls-file-fil file) extension)))
-    (if (probe-file path)
-	(progn
-	  (format t "File ~A already exists: skipping~%" path)
-	  nil)
-      (with-open-file (ostream path :direction :output)
-	(with-umls-file (line (umls-file-fil file))
-	  (princ (umls-translate file line) ostream)
-	  (princ #\newline ostream))
-	t))))
-
-(defun make-noneng-index-file (extension)
-  "Make non-english index file"
-  (let* ((outfile (find-umls-file "MRXW.NONENG"))
-	 (path (umls-pathname (umls-file-fil outfile) extension)))
-	
-    (if (probe-file path)
-	(progn
-	  (format t "File ~A already exists: skipping~%" path)
-	  nil)
-      (progn
-	(with-open-file (ostream path :direction :output)
-	  (dolist (inputfile (noneng-lang-index-files))
-	    (with-umls-file (line (umls-file-fil inputfile))
-	      (princ (umls-translate outfile line) ostream) ;; use outfile for custom cols
-	      (princ #\newline ostream))))
-	t))))
-
-(defun pg-copy-cmd (file extension)
-"Return postgresql copy statement for a file"  
-  (format nil "COPY ~a FROM '~a' using delimiters '|' with null as ''"
-	  (umls-file-table file) (umls-pathname (umls-file-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 (umls-file-fil file) extension) (umls-file-table file)))
-
-(defun umls-translate (file line)
-"Translate a single line for sql output"
-(string-trim-last-character
- (concatenate 'string
-   (mapcar2-append-string 
-    (lambda (col value)
-      (concatenate
-	  'string
-	(if (eq (umls-col-datatype col) 'sql-u)
-	    (format nil "~d" (parse-ui value ""))
-	  (escape-backslashes value))
-	"|"))
-    (remove-custom-cols (umls-file-colstructs file)) 
-    line)
-   (custom-col-values (custom-colstructs-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"