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))