- (loop
- for tuple in ,query collect
- (destructuring-bind ,fields tuple
- ,@body)))))))
-
-(defun umlisp-query (table fields srl where-name where-value
- &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 :order order :like like))))
-
-
-(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))
+ `(let ((,value ,where-value))
+ ,@(unless where-name `((declare (ignore ,value))))
+ (let ((,r '()))
+ (dolist (tuple (umlisp-query ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like))
+ (push (destructuring-bind ,fields tuple ,@body) ,r))
+ (nreverse ,r))
+ #+ignore
+ (loop for tuple in
+ (umlisp-query ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like)
+ collect (destructuring-bind ,fields tuple ,@body))))))
+
+(defmacro with-umlisp-query-eval ((table fields srl where-name where-value
+ &key (lrl "KCUILRL") distinct single
+ order like)
+ &body body)
+ (let ((value (gensym))
+ (r (gensym))
+ (eval-fields (cadr fields)))
+ (if single
+ `(let* ((,value ,where-value)
+ (tuple (car (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single
+ :distinct ,distinct :order ,order
+ :like ,like))))
+ (when tuple
+ (destructuring-bind ,eval-fields tuple
+ ,@body)))
+ `(let ((,value ,where-value)
+ (,r '()))
+ (dolist (tuple (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like))
+ (push (destructuring-bind ,eval-fields tuple ,@body) ,r))
+ (nreverse ,r)
+ #+ignore
+ (loop for tuple in
+ (umlisp-query-eval ,table ,fields ,srl ,where-name ,value
+ :lrl ,lrl :single ,single :distinct ,distinct
+ :order ,order :like ,like)
+ collect (destructuring-bind ,eval-fields tuple ,@body))))))
+
+;;;
+;;; Read from SQL database