From 31094d0b33bfd5cecceb2b77d5f51e4b78365b98 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Fri, 2 May 2003 22:30:34 +0000 Subject: [PATCH] r4744: *** empty log message *** --- sql-classes.lisp | 45 ++++++++++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 19 deletions(-) diff --git a/sql-classes.lisp b/sql-classes.lisp index 59efde5..c33a343 100644 --- a/sql-classes.lisp +++ b/sql-classes.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: Apr 2000 ;;;; -;;;; $Id: sql-classes.lisp,v 1.18 2003/05/02 21:49:19 kevin Exp $ +;;;; $Id: sql-classes.lisp,v 1.19 2003/05/02 22:30:34 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -29,13 +29,13 @@ (defmacro with-umlisp-query ((table fields srl where-name where-value &key (lrlname "KCUILRL") distinct single - terminal like) + order like) &body body) (let ((query (gensym))) `(unless (and ,where-name (not ,where-value)) (let ((,query (umlisp-query ,table ,fields ,srl ,where-name ,where-value :lrlname ,lrlname :single ,single :distinct ,distinct - :terminal ,terminal :like ,like))) + :order ,order :like ,like))) (if ,single (let ((tuple (car ,query))) (when tuple @@ -47,17 +47,17 @@ ,@body))))))) (defun umlisp-query (table fields srl where-name where-value - &key (lrlname "KCUILRL") single distinct terminal like) + &key (lrlname "KCUILRL") single distinct order like) "Query the UMLisp database. Return a list of umlisp objects whose name is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (when (or (not where-name) where-value) (mutex-sql-query (query-string table fields srl where-name where-value - :lrlname lrlname :single single :distinct distinct :terminal terminal :like like)))) + :lrlname lrlname :single single :distinct distinct :order order :like like)))) (defun query-string (table fields &optional srl where-name where-value - &key (lrlname "KCUILRL") single distinct terminal like) + &key (lrlname "KCUILRL") single distinct order like) (let ((qs (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" (if distinct "distinct " "") fields table))) @@ -73,8 +73,15 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (when srl (setq qs (concatenate 'string qs (format nil " and ~:@(~A~) <= ~D" lrlname srl)))) - (when terminal - (setq qs (concatenate 'string qs " " terminal))) + (when order + (setq qs (concatenate 'string qs + (format nil " order by ~{~:@(~A) ~A~^,~}" + (flatten + (loop for o in order + collect + (if (atom o) + (list o 'asc) + o))))))) (when single (setq qs (concatenate 'string qs " limit 1"))) qs)) @@ -138,7 +145,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui (ensure-integer cui) :pfstr pfstr :lrl (ensure-integer cuilrl))) - (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :terminal "order by CUI asc" :distinct t) + (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :order '((cui asc)) :distinct t) :database db))) (defun map-ucon-all (fn &key (srl *current-srl*)) @@ -151,7 +158,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (make-instance 'ucon :cui (ensure-integer cui) :pfstr pfstr :lrl (ensure-integer cuilrl)))) - (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :terminal "order by CUI asc" :distinct t) + (query-string 'mrcon '(cui kpfstr kcuilrl) srl nil nil :order '((cui asc)) :distinct t) :database db))) @@ -190,7 +197,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucoc-cui (cui &key (srl *current-srl*)) "Return a list of ucoc for cui" (with-umlisp-query ('mrcoc (cui2 soc cot cof coa kpfstr2) srl 'cui1 (parse-cui cui) - :lrlname "KSRL" :terminal "order by COF asc") + :lrlname "KSRL" :order '((cof asc))) (setq cui2 (ensure-integer cui2)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (parse-cui cui) :cui2 (ensure-integer cui2) :soc soc :cot cot @@ -199,7 +206,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucoc-cui2 (cui2 &key (srl *current-srl*)) "Return a list of ucoc for cui2" (with-umlisp-query ('mrcoc (cui1 soc cot cof coa kpfstr2) srl 'cui2 (parse-cui cui2) - :lrlname "KSRL" :terminal "order by COF asc") + :lrlname "KSRL" :order '((cof asc))) (setq cui2 (ensure-integer cui2)) (when (zerop cui2) (setq cui2 nil)) (make-instance 'ucoc :cui1 (ensure-integer cui1) :cui2 (parse-cui cui2) :soc soc :cot cot @@ -297,7 +304,7 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" :lrl lrl :str pfstr)) (query-string 'mrcon '(cui lui sui stt lrl kpfstr) srl nil nil :lrlname 'lrl :distinct t - :terminal "order by SUI asc") + :order '((sui asc))) :database db))) (defun find-string-sui (sui &key (srl *current-srl*)) @@ -388,38 +395,38 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun find-ucon-tui (tui &key (srl *current-srl*)) "Find list of ucon for tui" - (with-umlisp-query ('mrsty (cui) srl 'tui (parse-tui tui) :lrlname 'klrl :terminal "order by cui desc") + (with-umlisp-query ('mrsty (cui) srl 'tui (parse-tui tui) :lrlname 'klrl :order '((cui asc))) (find-ucon-cui (ensure-integer cui) :srl srl))) (defun find-ucon-word (word &key (srl *current-srl*) (like nil)) "Return list of ucons that match word. Optionally, use SQL's LIKE syntax" (with-umlisp-query ('mrxw_eng (cui) srl 'wd word :like like :distinct t - :lrlname 'klrl :terminal "order by cui desc") + :lrlname 'klrl :order '((cui asc))) (find-ucon-cui cui :srl srl))) (defun find-ucon-normalized-word (word &key (srl *current-srl*) (like nil)) "Return list of ucons that match word, optionally use SQL's LIKE syntax" (with-umlisp-query ('mrxnw_eng (cui) srl 'nwd word :like like :distinct t - :lrlname 'klrl :terminal "order by cui desc") + :lrlname 'klrl :order '((cui asc))) (find-ucon-cui cui :srl srl))) (defun find-ustr-word (word &key (srl *current-srl*)) "Return list of ustrs that match word" (with-umlisp-query ('mrxw_eng (cui sui) srl 'wd word :lrlname 'klrl - :terminal "order by cui desc, sui desc") + :order '((cui asc) (sui asc))) (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))) (defun find-ustr-normalized-word (word &key (srl *current-srl*)) "Return list of ustrs that match word" (with-umlisp-query ('mrxnw_eng (cui sui) srl 'nwd word :lrlname 'klrl - :terminal "order by cui desc, sui desc") + :order '((cui asc) (sui asc))) (find-ustr-cuisui (ensure-integer cui) (ensure-integer sui) :srl srl))) ;; Special tables (defun find-usrl-all () - (with-umlisp-query ('usrl (sab srl) nil nil nil :terminal "order by sab desc") + (with-umlisp-query ('usrl (sab srl) nil nil nil :order '((sab asc)) (make-instance 'usrl :sab sab :srl (ensure-integer srl)) usrls)) ;;; Multiword lookup and score functions -- 2.34.1