clsql/sql package.lisp,1.4,1.5 sql.lisp,1.5,1.6

Update of /pubcvs/clsql/sql
In directory boa.b9.com:/tmp/cvs-serv5530/sql

Modified Files:
	package.lisp sql.lisp 
Log Message:


Index: package.lisp
===================================================================
RCS file: /pubcvs/clsql/sql/package.lisp,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** package.lisp	7 May 2003 02:45:08 -0000	1.4
--- package.lisp	23 Jul 2003 19:33:38 -0000	1.5
***************
*** 87,90 ****
--- 87,91 ----
       #:map-query
       #:do-query
+      #:for-each-row
       
       ;; functional.cl

Index: sql.lisp
===================================================================
RCS file: /pubcvs/clsql/sql/sql.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** sql.lisp	6 May 2003 02:27:08 -0000	1.5
--- sql.lisp	23 Jul 2003 19:33:38 -0000	1.6
***************
*** 255,256 ****
--- 255,328 ----
    "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))))))