[bknr-cvs] r2122 - trunk/projects/bos/worldpay-test

[bknr at bknr.net]

Author: hhubner
Date: 2007-01-08 09:43:36 -0500 (Mon, 08 Jan 2007)
New Revision: 2122

Modified:
   trunk/projects/bos/worldpay-test/reports-xml-handler.lisp
Log:
Add new XML report handler all-contracts-m2s that includes sqm coordinates
for the contracts.


Modified: trunk/projects/bos/worldpay-test/reports-xml-handler.lisp
===================================================================
--- trunk/projects/bos/worldpay-test/reports-xml-handler.lisp	2007-01-02 11:24:22 UTC (rev 2121)
+++ trunk/projects/bos/worldpay-test/reports-xml-handler.lisp	2007-01-08 14:43:36 UTC (rev 2122)
@@ -34,8 +34,7 @@
 		   (error "invalid report name ~A" name))
 	       arguments)))))
 
-
-(defreport all-contracts ()
+(defun all-contracts/internal (&key include-coords)
   (dolist (contract *contracts-to-process*)
     (with-element "contract"
       (attribute "id" (store-object-id contract))
@@ -44,8 +43,19 @@
       (attribute "paid" (contract-paidp contract))
       (attribute "date-time" (format-date-time (contract-date contract) :xml-style t))
       (attribute "country" (sponsor-country (contract-sponsor contract)))
-      (attribute "sqm-count" (length (contract-m2s contract))))))
+      (attribute "sqm-count" (length (contract-m2s contract)))
+      (when include-coords
+	(dolist (m2 (contract-m2s contract))
+	  (with-element "m2"
+	    (attribute "utm-x" (m2-x m2))
+	    (attribute "utm-y" (m2-y m2))))))))
 
+(defreport all-contracts ()
+  (all-contracts/internal))
+
+(defreport all-contracts-m2s ()
+  (all-contracts/internal :include-coords t))
+
 (defun week-of-contract (contract)
   "Return Week key (YYYY-WW) for given contract."
   (multiple-value-bind (second minute hour date month year day-of-week is-dst tz) (decode-universal-time (contract-date contract))