X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-create.lisp;h=af0dd994e73921240b466d3c69e61b10c560d64a;hb=ebbaacd0a589db2c590846742da33e3b4bf25d02;hp=8a77db397408ecaa3b35f0268556c66958e73b1f;hpb=74e8c7ab60e8d315d20406e3a37ad5cac6abf8cd;p=umlisp.git diff --git a/sql-create.lisp b/sql-create.lisp index 8a77db3..af0dd99 100644 --- a/sql-create.lisp +++ b/sql-create.lisp @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-create.lisp,v 1.18 2003/05/06 06:44:17 kevin Exp $ +;;;; $Id: sql-create.lisp,v 1.19 2003/05/06 07:17:35 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -25,58 +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-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-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 values doquote) - (let ((custom-value (funcall (umls-col-custom-value-func col) values))) + (let ((custom-value (funcall (custom-value-fun col) values))) (if custom-value (if doquote - (let ((q (umls-col-quotechar col))) + (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 values doquote))) + (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+)) @@ -89,15 +89,15 @@ (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 @@ -119,7 +119,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" @@ -133,7 +133,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) @@ -196,7 +196,7 @@ This is much faster that using create-umls-db-insert." (defun translate-umls-file (file extension) "Translate a umls file into a format suitable for sql copy cmd" - (translate-files (umls-file-fil file) extension (list file))) + (translate-files (fil file) extension (list file))) (defun make-noneng-index-file (extension) "Make non-english index file" @@ -209,7 +209,7 @@ This is much faster that using create-umls-db-insert." (format t "File ~A already exists: skipping~%" output-path) (with-open-file (ostream output-path :direction :output) (dolist (input-file input-files) - (with-umls-file (line (umls-file-fil input-file)) + (with-umls-file (line (fil input-file)) (umls-translate input-file line ostream) (princ #\newline ostream))))))) @@ -217,17 +217,17 @@ This is much faster that using create-umls-db-insert." "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) + (if (eq (datatype col) 'sql-u) (let ((ui (parse-ui value ""))) (if (stringp ui) ui @@ -238,8 +238,8 @@ This is much faster that using create-umls-db-insert." "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 @@ -253,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))))) @@ -294,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 () @@ -305,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 #'>))))