From 6b0acc8fd6324c9a8000d224808a50a781ea8c74 Mon Sep 17 00:00:00 2001
From: "Kevin M. Rosenberg" <kevin@rosenberg.net>
Date: Tue, 16 Feb 2021 20:05:30 +0000
Subject: [PATCH] Add support for MYSQL 8 with sqlname indirection to prevent
 reserved word collisions

---
 classes.lisp         |  2 +-
 create-sql.lisp      |  4 ++--
 data-structures.lisp |  2 +-
 sql-classes.lisp     | 33 +++++++++++++++++++++++++++++----
 sql.lisp             |  4 ++--
 5 files changed, 35 insertions(+), 10 deletions(-)

diff --git a/classes.lisp b/classes.lisp
index 1c65629..ce08ece 100644
--- 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 20964f5..3a19020 100644
--- 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 e658c10..f45de42 100644
--- 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 d1e19f3..2b468dc 100644
--- 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 27f6c4d..7c6cc2c 100644
--- 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+)))
-- 
2.34.1