;;;;
;;;; Name: sql-create
;;;; Purpose: Create SQL database for UMLisp
-;;;; Programmer: Kevin M. Rosenberg
+;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: sql-create.lisp,v 1.9 2003/05/06 02:14:59 kevin Exp $
+;;;; $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.
"Return sql command to create a table"
(let ((col-func
(lambda (c)
- (let ((sqltype (umls-col-sqltype c)))
+ (let ((sqltype (sqltype c)))
(concatenate 'string
- (umls-col-col c)
+ (col c)
" "
(if (or (string-equal sqltype "VARCHAR")
(string-equal sqltype "CHAR"))
- (format nil "~a (~a)" sqltype (umls-col-max c))
+ (format nil "~a (~a)" sqltype (cmax c))
sqltype))))))
- (format nil "CREATE TABLE ~a (~{~a~^,~})" (umls-file-table file)
- (mapcar col-func (umls-cols-for-umls-file file)))))
+ (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 (umls-col-parsefunc col))
+ (if (null (parse-fun col))
value
- (format nil "~A" (funcall (umls-col-parsefunc 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 (umls-col-quotechar col)))
+ (let ((q (quotechar col)))
(concatenate 'string q (insert-col-value col value) q)))))
(format
nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
- (umls-file-table file)
- (umls-file-fields file)
+ (table file)
+ (fields file)
(concat-separated-strings
","
- (mapcar insert-func (remove-custom-cols (umls-file-colstructs file)) values)
- (custom-col-values (custom-colstructs-for-file file) values t)))))
+ (mapcar insert-func (remove-custom-cols (ucols file)) values)
+ (custom-col-values (custom-ucols-for-file file) values t)))))
-(defun custom-col-value (col doquote values)
- (let ((custom-value (funcall (umls-col-custom-value-func col) values)))
- (if doquote
- (let ((q (umls-col-quotechar col)))
- (concatenate 'string q (escape-backslashes custom-value) q))
- (escape-backslashes custom-value))))
+(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 (colstructs values doquote)
+(defun custom-col-values (ucols values doquote)
"Returns a list of string column values for SQL inserts for custom columns"
- (loop for col in colstructs collect (custom-col-value col doquote values)))
-
+ (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 #'umls-col-custom-value-func 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+))
(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 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 (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"))))
+ (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
"SQL Databases: drop all tables"
(dolist (file *umls-files*)
(ignore-errors
- (sql-execute (format nil "DROP TABLE ~a" (umls-file-table file)) conn))))
+ (sql-execute (format nil "DROP TABLE ~a" (table file)) conn))))
(defun sql-create-tables (conn)
"SQL Databases: create all tables"
(defun sql-insert-values (conn file)
"SQL Databases: inserts all values for a file"
- (with-umls-file (line (umls-file-fil file))
+ (with-umls-file (line (fil file))
(sql-execute (insert-values-cmd file line) conn)))
(defun sql-insert-all-values (conn)
(make-noneng-index-file extension)
(dolist (f *umls-files*) (translate-umls-file f extension)))
-(defun translate-file (filename extension files)
- "Translate a umls file into a format suitable for sql copy cmd"
- (let ((path (umls-pathname filename extension))
- (input-files (mklist files)))
- (if (probe-file path)
- (format t "File ~A already exists: skipping~%" path)
- (dolist (input-file input-files)
- (with-open-file (ostream :direction :output)
- (with-umls-file (line (umls-file-fil input-file))
- (umls-translate file line ostream)
- (princ #\newline ostream)))))))
-
(defun translate-umls-file (file extension)
"Translate a umls file into a format suitable for sql copy cmd"
- (translate-file (umls-file-fil file) extension (umls-file-fil file)))
+ (translate-files file extension (list file)))
(defun make-noneng-index-file (extension)
"Make non-english index file"
- (translate-file (find-umls-file "MRXW.NONENG" extension
- (noneng-lang-index-files))))
+ (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 ''"
- (umls-file-table file) (umls-pathname (umls-file-fil file) extension)))
+ (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 (umls-file-fil file) extension) (umls-file-table file)))
+ (umls-pathname (fil file) extension) (table file)))
(defun col-value (col value)
- (if (eq (umls-col-datatype col) 'sql-u)
- (write-to-string (parse-ui value ""))
- (escape-backslashes value)))
-
-(defun umls-translate (file line strm)
+ (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 (umls-file-colstructs file)) line)
- (custom-col-values (custom-colstructs-for-file file) line nil)))
+ (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
(unavoidable '())
(avoidable '()))
(dolist (file *umls-files*)
- (dolist (col (umls-file-colstructs file))
- (let* ((avwaste (- (umls-col-max col) (umls-col-av col)))
- (cwaste (* avwaste (umls-file-rws file))))
+ (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 (umls-file-fil file) (umls-col-col col)
+ (push (list (fil file) (col col)
avwaste cwaste)
unavoidable))
(progn
(incf totalavoidable cwaste)
- (push (list (umls-file-fil file) (umls-col-col col)
+ (push (list (fil file) (col col)
avwaste cwaste)
avoidable)))
(incf totalwaste cwaste)))))
(let ((max 0))
(declare (fixnum max))
(dolist (col *umls-cols*)
- (when (> (umls-col-max col) max)
- (setq max (umls-col-max col))))
+ (when (> (cmax col) max)
+ (setq max (cmax col))))
max))
(defun max-umls-row ()
(let ((rowsizes '()))
(dolist (file *umls-files*)
(let ((row 0)
- (fields (umls-file-colstructs file)))
+ (fields (ucols file)))
(dolist (field fields)
- (incf row (1+ (umls-col-max field))))
+ (incf row (1+ (cmax field))))
(push row rowsizes)))
(car (sort rowsizes #'>))))
projects / umlisp.git / blobdiff