X-Git-Url: http://git.kpe.io/?p=umlisp.git;a=blobdiff_plain;f=create-sql.lisp;h=88fa898fb89814d881ec3b1c6b3fbe551551fc02;hp=79732ebc649e4cc5816049944be951ce9f6ac470;hb=f2f3771917e7d8c2999615d3f30641c8ee251872;hpb=8dc001f5e7cf851c06006e489473a85611d348be

diff --git a/create-sql.lisp b/create-sql.lisp
index 79732eb..88fa898 100644
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -206,13 +206,56 @@
      (format nil "DROP INDEX ~a"
              (concatenate 'string tablename "_" colname "_X")))))
 
+(defun sql-create-indexes-mysql (conn indexes verbose)
+  (let ((tables nil)
+        (table-cols nil))
+    (dolist (idx indexes)
+      (pushnew (second idx) tables :test 'string-equal)
+      (let ((table-col (find (second idx) table-cols :key 'car :test 'string-equal)))
+        (if table-col
+            (vector-push-extend (cons (first idx) (third idx)) (second table-col))
+            (push (list (second idx) (make-array (list 1) :initial-contents (list (cons (first idx) (third idx)))
+                                                 :adjustable t :fill-pointer 1))
+                  table-cols))))
+    (dolist (table tables)
+      (let ((table-col (find table table-cols :key 'car :test 'string-equal))
+            (first t)
+            (str (format nil "ALTER TABLE ~A" table)))
+        (loop for col across (second table-col)
+           do
+             (let ((colname (car col))
+                   (length (cdr col)))
+               (ignore-errors (sql-execute (drop-index-cmd colname table) conn))
+               (setq str (concatenate 'string
+                                      str
+                                      (if first
+                                          (progn
+                                            (setq first nil)
+                                            " ")
+                                          ", ")
+                                      (format nil "ADD INDEX ~A (~A)"
+                                              (concatenate 'string table "_" colname "_X")
+                                              (concatenate 'string
+                                                           colname
+                                                           (if (integerp length)
+                                                               (format nil " (~d)" length)
+                                                               "")))))))
+        (when verbose
+          (format t "UMLS Import: Creating indexes for columns ~A on table ~A.~%"
+                  (mapcar 'car (coerce (second table-col) 'list)) table))
+        (when conn
+          (sql-execute str conn))
+        ))))
+
 (defun sql-create-indexes (conn &key (indexes +index-cols+) verbose)
   "SQL Databases: create all indexes"
-  (dolist (idx indexes)
-    (when verbose (format t "UMLS Import: Creating index for column ~A on table ~A.~%"
-                          (first idx) (second idx)))
-    (ignore-errors (sql-execute (drop-index-cmd (car idx) (cadr idx)) conn))
-    (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn)))
+  (if (eql :mysql *umls-sql-type*)
+      (sql-create-indexes-mysql conn indexes verbose)
+      (dolist (idx indexes)
+        (when verbose (format t "UMLS Import: Creating index for column ~A on table ~A.~%"
+                              (first idx) (second idx)))
+        (ignore-errors (sql-execute (drop-index-cmd (car idx) (cadr idx)) conn))
+        (sql-execute (create-index-cmd (car idx) (cadr idx) (caddr idx)) conn))))
 
 (defun make-usrl (conn)
   (if (eql :mysql *umls-sql-type*)
@@ -306,9 +349,10 @@ This is much faster that using create-umls-db-insert."
                             #+lispworks :UTF-8
                             #+(and clisp unicode) :external-format
                             #+(and clisp unicode) charset:utf-8)
-          (do ()
-              ((eq (read-line ts nil eof) eof))
-            (incf translated-lines)))
+          (do ((c (read-char ts nil eof) (read-char ts nil eof)))
+              ((eq c eof))
+            (when (eql c #\newline)
+              (incf translated-lines))))
         (dolist (input-ufile input-ufiles)
           (with-umls-ufile (line input-ufile)
                            (incf input-lines)