X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-create.lisp;h=49f550e9b99bf7f36c26bffdd1ebd770d50825fb;hb=7e088e3bca94e4cba5a00f3c3734db4ea57f4e2f;hp=c9821fd742e7f77a108b89fcdcd5b4d9bc4cf813;hpb=cc146d0b1c7d6d7a050713754f1ea9a8d71a46b5;p=umlisp.git diff --git a/sql-create.lisp b/sql-create.lisp index c9821fd..49f550e 100644 --- a/sql-create.lisp +++ b/sql-create.lisp @@ -4,10 +4,10 @@ ;;;; ;;;; 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. @@ -25,57 +25,58 @@ "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+)) @@ -84,19 +85,18 @@ (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 @@ -118,7 +118,7 @@ "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" @@ -132,7 +132,7 @@ (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) @@ -193,51 +193,53 @@ This is much faster that using create-umls-db-insert." (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 @@ -251,19 +253,19 @@ This is much faster that using create-umls-db-insert." (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))))) @@ -292,8 +294,8 @@ This is much faster that using create-umls-db-insert." (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 () @@ -303,8 +305,8 @@ This is much faster that using create-umls-db-insert." (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 #'>))))