r5378: *** empty log message ***

diff --git a/ChangeLog b/ChangeLog
index 394682ecd25ce3cd4670f20ed29b0238306677e2..04dde1ceb5de8be36b824ae0d5fed4a0e5145d88 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,6 @@
+23 Jul 2003 Kevin Rosenberg (kevin@rosenberg.net)
+       * Add for-each-row macro
+
 12 Dec 2002 Kevin Rosenberg (kevin@rosenberg.net)
        * uffi/clsql-uffi.lisp: return NIL for numeric fields that are NULL
        

diff --git a/debian/changelog b/debian/changelog
index 04c48daf6c5fcf5c893edef262e0234ef3a371b3..7b2cc7c9fba8ca94e4bf1a1ef63bc3fa9755732c 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-sql (1.7.2-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Wed, 23 Jul 2003 12:59:46 -0600
+
 cl-sql (1.7.1-1) unstable; urgency=low
 
   * New upstream

diff --git a/sql/package.lisp b/sql/package.lisp
index 0b834687622de4c4f3daed8741a0c4e412eba4be..5ee30377951fc3b5808271d91506b2c4e990144b 100644 (file)
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -8,7 +8,7 @@
 ;;;;                Original code by Pierre R. Mai 
 ;;;; Date Started:  Feb 2002
 ;;;;
-;;;; $Id: package.lisp,v 1.4 2003/05/07 02:45:08 kevin Exp $
+;;;; $Id: package.lisp,v 1.5 2003/07/23 19:33:38 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -86,6 +86,7 @@
      #:execute-command
      #:map-query
      #:do-query
+     #:for-each-row
      
      ;; functional.cl
      #:insert-records

diff --git a/sql/sql.lisp b/sql/sql.lisp
index 125de200816019409c9dfbbb448a08639cf31178..515ed83feb27fa47796079b5a361548c6150d244 100644 (file)
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -7,7 +7,7 @@
 ;;;; Authors:      Kevin M. Rosenberg based on code by Pierre R. Mai 
 ;;;; Date Started: Feb 2002
 ;;;;
-;;;; $Id: sql.lisp,v 1.5 2003/05/06 02:27:08 kevin Exp $
+;;;; $Id: sql.lisp,v 1.6 2003/07/23 19:33:38 kevin Exp $
 ;;;;
 ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai
@@ -254,3 +254,75 @@ specified in output-type-spec and returned like in MAP."
 (defun delete-large-object (object-id &key (database *default-database*))
   "Deletes the large object in the database"
   (database-delete-large-object object-id database))
+
+
+;;; Row processing macro
+
+
+
+(defun lisp->sql-name (field)
+  (typecase field
+    (string field)
+    (symbol (string-upcase (symbol-name field)))
+    (cons (cadr field))
+    (t (format nil "~A" field))))
+
+(defun field-names (field-forms)
+  "Return a list of field name strings from a fields form"
+  (loop for field-form in field-forms
+       collect
+       (lisp->sql-name
+        (if (cadr field-form)
+            (cadr field-form)
+            (car field-form)))))
+
+(defun from-names (from)
+  "Return a list of field name strings from a fields form"
+  (loop for table in (if (atom from) (list from) from)
+       collect (lisp->sql-name table)))
+
+
+(defun where-strings (where)
+  (loop for w in (if (atom (car where)) (list where) where)
+       collect
+       (if (consp w)
+           (format nil "~A ~A ~A" (second w) (first w) (third w))
+           (format nil "~A" w))))
+
+(defun order-by-strings (order-by)
+  (loop for o in order-by
+       collect
+       (if (atom o)
+           (lisp->sql-name o)
+           (format nil "~A ~A" (lisp->sql-name (car o))
+                   (lisp->sql-name (cadr o))))))
+
+(defun query-string (fields from where distinct order-by limit)
+  (concatenate
+   'string
+   (format nil "select ~A~{~A~^,~} from ~{~A~^ and ~}" 
+          (if distinct "distinct " "") (field-names fields)
+          (from-names from))
+   (if where (format nil " where ~{~A~^ ~}"
+                    (where-strings where)) "")
+   (if order-by (format nil " order by ~{~A~^, ~}"
+                       (order-by-strings order-by)))
+   (if limit (format nil " limit ~D" limit) "")))
+
+(defmacro for-each-row (((&rest fields) &key from order-by where distinct limit) &body body)
+  (let ((d (gensym "DISTINCT-"))
+       (bind-fields (loop for f in fields collect (car f)))
+       (w (gensym "WHERE-"))
+       (o (gensym "ORDER-BY-"))
+       (frm (gensym "FROM-"))
+       (l (gensym "LIMIT-"))
+       (q (gensym "QUERY-")))
+    `(let ((,frm ,from)
+          (,w ,where)
+          (,d ,distinct)
+          (,l ,limit)
+          (,o ,order-by))
+      (let ((,q (query-string ',fields ,frm ,w ,d ,o ,l)))
+       (loop for tuple in (query ,q)
+             collect (destructuring-bind ,bind-fields tuple
+                  ,@body))))))