X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql-create.lisp;h=236b137ed763c7aea20df66b7f9ac7c738f4cd1a;hb=58e6e7e38d835e51beb5f21440b4b7bd27d106f2;hp=101a02a06a0debfac257b5450cb1c287b55749e8;hpb=48a89995e768d67fcda55849a70b0ea759ad190a;p=umlisp.git

diff --git a/sql-create.lisp b/sql-create.lisp
index 101a02a..236b137 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.6 2003/05/04 08:55:52 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.
@@ -94,10 +94,11 @@
 	   (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)))))
 
@@ -114,7 +115,7 @@
 		       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)))
@@ -123,7 +124,7 @@
 
 (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)
@@ -236,7 +237,7 @@ This is much faster that using create-umls-db-insert."
   (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)
@@ -247,7 +248,7 @@ This is much faster that using create-umls-db-insert."
 (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"
@@ -258,7 +259,7 @@ This is much faster that using create-umls-db-insert."
 	  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))))
 
@@ -275,7 +276,7 @@ This is much faster that using create-umls-db-insert."
 	  (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))))
 
@@ -305,20 +306,34 @@ This is much faster that using create-umls-db-insert."
 		 line)
 		(custom-col-values-old (custom-colstructs-for-file file) line "|" nil))))
 
-(defun umls-translate (file line)
+(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