Add support for MYSQL 8 with sqlname indirection to prevent reserved word collisions

diff --git a/classes.lisp b/classes.lisp
index 1c656299575a35e334ae89ac3b442bd96de44f8f..ce08ece3ac09671aebc21c4f17686e955b3d129a 100644 (file)
--- a/classes.lisp
+++ b/classes.lisp
@@ -38,7 +38,7 @@
    (suppress :value-type string :initarg :suppress :reader suppress))
   (:metaclass hyperobject-class)
   (:user-name "Rank")
-  (:default-print-slots rank sab tty suppres))
+  (:default-print-slots rank sab tty suppress))
 
 (defclass udef (umlsclass)
   ((def :value-type cdata :initarg :def :reader def)

diff --git a/create-sql.lisp b/create-sql.lisp
index 20964f5c4ae3a6a8f4023ecf033582a759061856..3a1902019df6632feb72dcfecb2d3595913912c7 100644 (file)
--- a/create-sql.lisp
+++ b/create-sql.lisp
@@ -30,7 +30,7 @@
                   (setq sqltype "VARCHAR2(20)")))))
 
              (concatenate 'string
-               (col c)
+               (sqlname c)
                " "
                (if (or (string-equal sqltype "VARCHAR")
                        (string-equal sqltype "CHAR"))
@@ -403,7 +403,7 @@ This is much faster that using create-umls-db-insert."
           (delete-file output-path)
           nil)
         ((eql input-lines translated-lines)
-          (format t "Translated file ~A already exists: skipping...~%" output-path)
+          (format t "Translated file ~A exists and is proper number of lines: skipping...~%" output-path)
           t)
         ((eql input-lines 0)
           (warn "The number of input lines is 0 for output file ~A." output-path)

diff --git a/data-structures.lisp b/data-structures.lisp
index e658c1063a643d7f208b87a6117422e33f207873..f45de422125d88abf9fb2751880d5d7140ddefb2 100644 (file)
--- a/data-structures.lisp
+++ b/data-structures.lisp
@@ -28,7 +28,7 @@
   (make-pathname :directory '(:relative "META")))
 
 (defparameter *lex-dir*
-  (make-pathname :directory '(:relative "LEX" "LEX")))
+  (make-pathname :directory '(:relative "LEX")))
 
 (defparameter *net-dir*
   (make-pathname :directory '(:relative "NET")))

diff --git a/sql-classes.lisp b/sql-classes.lisp
index d1e19f3fea74dd3a36293dab1793f3b24250fad4..2b468dc095080d61e621470005df128dbf1131b1 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -23,17 +23,31 @@
 (defun set-current-srl (srl)
   (setq *current-srl* srl))
 
+;; SQLNAME is required for collision of SQL reserved words (MYSQL 8: RANK)
+;; and column names in UMLS (RANK in MRRANK)
+(defvar *sql-reserved-names* '("RANK"))
+(defmethod sqlname ((c ucol))
+  (sqlname (col c)))
+(defmethod sqlname ((name string))
+  (if (find name *sql-reserved-names* :test #'string-equal)
+      (concatenate 'string "_" name)
+    name))
+(defmethod sqlname ((l list))
+  (mapcar #'sqlname l))
+(defmethod sqlname ((s symbol))
+  (sqlname (symbol-name s)))
+
 (defmacro query-string (table fields srl where-name where-value
                         &key (lrl "KCUILRL") single distinct order like limit
                         filter)
   (let* ((%%fields (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
-                           (if distinct "DISTINCT " "") fields table))
+                           (if distinct "DISTINCT " "") (sqlname fields) table))
          (%%order (if order (format nil " ORDER BY ~{~:@(~A~) ~(~A~)~^,~}"
                                     order)
                       ""))
          (%%lrl (format nil " AND ~:@(~A~)<=" lrl))
          (%%where (when where-name
-                    (format nil " WHERE ~:@(~A~)~A" where-name
+                    (format nil " WHERE ~:@(~A~)~A" (sqlname where-name)
                           (if like " like " ""))))
          (%filter (gensym "FILTER-"))
          (%single (gensym "SINGLE-"))
@@ -77,8 +91,8 @@
   (concatenate
    'string
    (format nil "SELECT ~A~{~:@(~A~)~^,~} FROM ~:@(~A~)"
-           (if distinct "DISTINCT " "") fields table)
-   (if where-name (format nil " WHERE ~:@(~A~)" where-name) "")
+           (if distinct "DISTINCT " "") (sqlname fields) table)
+   (if where-name (format nil " WHERE ~:@(~A~)" (sqlname where-name)) "")
    (if where-name
        (format nil
                (typecase where-value
@@ -1130,3 +1144,14 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-ustats-srl (srl)
   (collect-umlisp-query (ustats (name count) nil srl srl :order (name asc))
                            (make-instance 'ustats :name name :hits (ensure-integer count))))
+
+(defun find-urank-sab (sab &key (srl *current-srl*))
+  (collect-umlisp-query (mrrank (rank sab suppress tty) nil sab sab)
+                        (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress)))
+
+(defun find-urank-all (&key (srl *current-srl*))
+  (if srl
+      (collect-umlisp-query (mrrank (rank sab suppress tty) nil ksrl srl)
+                            (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))
+      (collect-umlisp-query (mrrank (rank sab suppress tty ksrl) nil nil nil)
+                            (make-instance 'urank :rank rank :sab sab :tty tty :suppress suppress))))

diff --git a/sql.lisp b/sql.lisp
index 27f6c4d3926eb1af43e6c380ef84419bb04b34b0..7c6cc2c42c01df87469ef44b363d1a93c72ef19a 100644 (file)
--- a/sql.lisp
+++ b/sql.lisp
@@ -22,10 +22,10 @@
       (:2006ad . "MTS2006AD")
       (:2009ab . "MTS2009AB")
       (:2010aa . "MTS2010AA")
-      (:2012ab . "MTS2012AB")
+      (:2012ab_all . "MTS2012AB_ALL")
       (:2014ab . "MTS2014AB")
       (:2017aa . "KUMLS2017AA")))
-(defvar +default-umls-db+ "KUMLS2017AA")
+(defvar +default-umls-db+ "MTS2012AB_ALL")
 
 (defun lookup-db-name (db)
   (cdr (assoc (ensure-keyword db) +umls-sql-map+)))