From bfaa0f22372eeb1abe3ab89dcb9daffee8deb5fd Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sat, 3 May 2003 19:32:00 +0000 Subject: [PATCH] r4750: Auto commit for Debian build --- sql-classes.lisp | 50 ++++++++++++++++++++++-------------------------- 1 file changed, 23 insertions(+), 27 deletions(-) diff --git a/sql-classes.lisp b/sql-classes.lisp index b3994ef..1fe0723 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.23 2003/05/03 18:16:16 kevin Exp $ +;;;; $Id: sql-classes.lisp,v 1.24 2003/05/03 19:32:00 kevin Exp $ ;;;; ;;;; This file, part of UMLisp, is ;;;; Copyright (c) 2000-2002 by Kevin M. Rosenberg, M.D. @@ -58,32 +58,28 @@ is OBJNAME from TABLE where WHERE-NAME field = WHERE-VALUE with FIELDS" (defun query-string (table fields &optional srl where-name where-value &key (lrlname "KCUILRL") single distinct order like) - (let ((qs (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" - (if distinct "distinct " "") - fields table))) - (when where-name - (setq qs (concatenate 'string qs - (format nil - (if (stringp where-value) - (if like - " where ~A like '%~A%'" - " where ~A='~A'") - " where ~A=~A") - where-name where-value)))) - (when srl - (setq qs (concatenate 'string qs (format nil " and ~:@(~A~) <= ~D" - lrlname srl)))) - (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) - (list (car o) (cdr o))))))))) - (when single - (setq qs (concatenate 'string qs " limit 1"))) - qs)) + (concatenate + 'string + (format nil "select ~A~{~:@(~A~)~^,~} from ~:@(~A~)" + (if distinct "distinct " "") fields table) + (if where-name + (format nil + (if (stringp where-value) + (if like + " where ~A like '%~A%'" + " where ~A='~A'") + " where ~A=~A") + where-name where-value) + "") + (if srl (format nil " and ~:@(~A~) <= ~D" lrlname srl) "") + (if order + (format nil " order by ~{~:@(~A~) ~(~A~)~^,~}" + (flatten (loop for o in order collect + (if (atom o) + (list o 'asc) + (list (car o) (cdr o)))))) + "") + (if single " limit 1" ""))) (defun find-ucon-cui (cui &key (srl *current-srl*)) "Find ucon for a cui" -- 2.34.1