r11148: fix limit / filter, improve udoc support

[umlisp.git] / sql-classes.lisp

diff --git a/sql-classes.lisp b/sql-classes.lisp
index 9d6852b8cca7bcebda125394e74023f02b7b6631..c91ee8a11b6144b77d769d6af515606d3b282197 100644 (file)
--- a/sql-classes.lisp
+++ b/sql-classes.lisp
@@ -37,10 +37,12 @@
         (%%where (when where-name
                    (format nil " where ~:@(~A~)~A" where-name
                          (if like " like " ""))))
-         (%%limit (gensym "LIMIT-"))
-         (%%filter (gensym "FILTER-")))
-    `(let ((%%limit ,limit)
-           (%%filter ,filter))
+         (%filter (gensym "FILTER-"))
+         (%single (gensym "SINGLE-"))
+         (%limit (gensym "LIMIT-")))
+    `(let ((,%limit ,limit)
+           (,%single ,single)
+           (,%filter ,filter))
        (concatenate
         'string
         ,%%fields
@@ -56,20 +58,20 @@
                  " is null")
                 (t
                  (format nil ,(if like "'%~A%'" "='~A'") ,where-value)))))
-        (if ##filter (concatenate 'string " AND " ##filter) "")
+        (if ,%filter (concatenate 'string
+                                  ,(if %%where " AND " " WHERE ")
+                                  ,%filter) "")
         (if ,srl (concatenate 'string ,%%lrl (write-to-string ,srl)) "")
         ,@(when %%order (list %%order))
-        (if (or ,single ##limit)
-            (cond
-             ((and ,single (> ##limit 1))
-              (error "Can't set single and limit > 1."))
-             (,single
-              " LIMIT 1")
-             (##limit
-              (format nil " LIMIT ~D" ##limit))
-             (t
-              ""))
-          "")))))
+        (cond
+         ((and ,%single ,%limit)
+          (error "Can't set single and limit"))
+         (,%single
+          " LIMIT 1")
+         (,%limit
+          (format nil " LIMIT ~D" ,%limit))
+         (t
+          ""))))))
 
 (defun query-string-eval (table fields &optional srl where-name where-value
                          &key (lrl "KCUILRL") single distinct order like limit filter)
@@ -102,7 +104,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(,query-cmd
     (query-string ,table ,fields ,srl ,where-name ,where-value
      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
-     :filter filter :limit ,limit)))
+     :filter ,filter :limit ,limit)))
 
 (defmacro umlisp-query-eval (table fields srl where-name where-value
                     &key (lrl "KCUILRL") single distinct order like 
@@ -112,7 +114,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   `(mutex-sql-query
     (query-string-eval ,table ,fields ,srl ,where-name ,where-value
      :lrl ,lrl :single ,single :distinct ,distinct :order ,order :like ,like
-     :filter filter :limit ,limit)))
+     :filter ,filter :limit ,limit)))
 
 ;; only WHERE-VALUE and SRL are evaluated
 (defmacro collect-umlisp-query ((table fields srl where-name where-value
@@ -242,10 +244,12 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
   "Find preferred string for a cui"
   (ensure-cui-integer cui)
   (or
-   (collect-umlisp-query (mrconso (kpfstr) srl cui cui :distinct t 
-                                  :filter " KPFENG=1" :single t))
-   (collect-umlisp-query (mrconso (kpfstr) srl cui cui :distinct t 
-                                  :single t))))
+   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t 
+                                  :filter " KPFENG=1" :single t)
+      str)
+   (collect-umlisp-query (mrconso (str) srl cui cui :distinct t 
+                                  :single t)
+      str)))
 
 (defun find-ucon-lui (lui &key (srl *current-srl*))
   "Find list of ucon for lui"
@@ -344,24 +348,21 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 (defun find-udoc-key (key)
   "Return list of abbreviation documentation for a key"
   (collect-umlisp-query (mrdoc (value type expl) nil dockey key)
-    (make-instance 'udoc :key key :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey key :dvalue value :dtype type :expl expl)))
 
 (defun find-udoc-value (value)
   "Return abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey type expl) nil value value)
-    (make-instance 'udoc :key dockey :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
-(defun find-udoc-key-value (key value)
-  (let ((tuple (car (mutex-sql-query
-                    (format nil "SELECT TYPE,EXPL FROM MRDOC WHERE DOCKEY='~A' AND VALUE='~A'"
-                            key value)))))
-    (when tuple
-      (make-instance 'udoc :key key :value value :type (first tuple) :expl (second tuple)))))
+(defun find-udoc-key-value (dockey value)
+  (collect-umlisp-query (mrdoc (type expl) nil dockey dockey :filter (format nil "VALUE='~A'" value))
+      (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
 (defun find-udoc-all ()
   "Return all abbreviation documentation"
   (collect-umlisp-query (mrdoc (dockey value type expl) nil nil nil)
-    (make-instance 'udoc :key dockey :value value :type type :expl expl)))
+    (make-instance 'udoc :dockey dockey :dvalue value :dtype type :expl expl)))
 
 (defun find-usty-cui (cui &key (srl *current-srl*))
   "Return a list of usty for cui"
@@ -540,7 +541,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
 
 (defun find-uso-cui (cui &key (srl *current-srl*) (english-only nil) limit)
   (ensure-cui-integer cui)
-  (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str) 
+  (collect-umlisp-query (mrconso (aui sab code srl tty saui sdui scui lat str sui) 
                                  srl cui cui :lrl srl :limit limit
                                  :filter (when english-only "LAT='ENG'"))
      (make-instance 'uso :aui aui :sab sab :code code :srl srl :tty tty
@@ -620,7 +621,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS"
     (find-usty-tui tui)))
 
 (defun find-usab-all ()
-  "Find usab for a key"
+  "Return all usab objects"
   (collect-umlisp-query (mrsab (vcui rcui vsab rsab son sf sver vstart vend imeta
                                  rmeta slc scc srl tfr cfr cxty ttyl atnl lat
                                  cenc curver sabin ssn scit) nil nil nil)