;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id: sql-create.lisp,v 1.5 2003/05/04 08:52:13 kevin Exp $
+;;;; $Id: sql-create.lisp,v 1.7 2003/05/05 23:13:28 kevin Exp $
;;;;
;;;; This file, part of UMLisp, is
;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D.
(format nil "~a (~a)" sqltype (umls-col-max c))
sqltype))))))
(format nil "CREATE TABLE ~a (~{~a~^,~})" (umls-file-table file)
- (mapcar col-func (umls-cols-for-umls-file file))))))
+ (mapcar col-func (umls-cols-for-umls-file file)))))
(defun create-custom-table-cmd (tablename sql-cmd)
"Return SQL command to create a custom table"
(mapcar2-append-string insert-func
(remove-custom-cols (umls-file-colstructs file))
values)
- (custom-col-values (custom-colstructs-for-file file) values "," t)))
+ (custom-col-values-old (custom-colstructs-for-file file) values "," t)))
)))
(defun insert-col-value (col value)
(let ((q (umls-col-quotechar col)))
(concatenate 'string q (insert-col-value col value) q)))))
(format
- nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~{~a~^,~})"
+ nil "INSERT INTO ~a (~{~a~^,~}) VALUES (~A)"
(umls-file-table file)
(umls-file-fields file)
- (append
+ (concat-separated-strings
+ ","
(mapcar insert-func (remove-custom-cols (umls-file-colstructs file)) values)
(custom-col-values (custom-colstructs-for-file file) values t)))))
delim)))
result))
-(defun col-value (col doquote values)
+(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)))
(defun custom-col-values (colstructs values doquote)
"Returns a list of string column values for SQL inserts for custom columns"
- (loop for col in colstructs collect (col-value col doquote values)))
+ (loop for col in colstructs collect (custom-col-value col doquote values)))
(defun remove-custom-cols (cols)
(with-sql-connection (conn)
(sql-drop-tables conn)
(sql-create-tables conn)
- (mapcar
+ (map 'nil
#'(lambda (file) (sql-execute (funcall copy-cmd file extension) conn))
*umls-files*)
(sql-create-indexes conn)
(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*))
+ (map 'nil (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"
nil)
(with-open-file (ostream path :direction :output)
(with-umls-file (line (umls-file-fil file))
- (princ (umls-translate file line) ostream)
+ (umls-translate file line ostream)
(princ #\newline ostream))
t))))
(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
+ (umls-translate outfile line ostream) ;; use outfile for custom cols
(princ #\newline ostream))))
t))))
"|"))
(remove-custom-cols (umls-file-colstructs file))
line)
- (custom-col-values (custom-colstructs-for-file file) line "|" nil))))
-
-(defun umls-translate (file line)
+ (custom-col-values-old (custom-colstructs-for-file file) line "|" nil))))
+
+(defun concat-separated-strings (separator &rest lists)
+ (format nil (format nil "~~{~~A~~^~A~~}" separator) (mapappend #'identity lists)))
+
+(defun print-separated-strings (strm separator &rest lists)
+ (declare (optimize (speed 3) (safety 0) (space 0) (debug 0) (compilation-speed 0)))
+ (do* ((rest-lists lists (cdr rest-lists))
+ (list (car rest-lists) (car rest-lists))
+ (last-list (null (cdr rest-lists)) (null (cdr rest-lists))))
+ ((null list) strm)
+ (do* ((lst list (cdr lst))
+ (elem (car lst) (car lst))
+ (last-elem (null (cdr lst)) (null (cdr lst))))
+ ((null lst))
+ (write-string elem strm)
+ (unless (and last-elem last-list)
+ (write-string separator strm)))))
+
+(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)
"Translate a single line for sql output"
- (format nil "~{~A~^|~}"
- (append
- (mapcar
- (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))))
+ (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)))
;;; Routines for analyzing cost of fixed size storage