Revision: 3488 Author: ksprotte URL: http://bknr.net/trac/changeset/3488

country-stats-handler now uses queries from contract-stats U trunk/projects/bos/m2/m2.lisp U trunk/projects/bos/m2/packages.lisp U trunk/projects/bos/web/kml-handlers.lisp

Modified: trunk/projects/bos/m2/m2.lisp =================================================================== --- trunk/projects/bos/m2/m2.lisp 2008-07-17 12:57:00 UTC (rev 3487) +++ trunk/projects/bos/m2/m2.lisp 2008-07-17 13:06:23 UTC (rev 3488) @@ -591,7 +591,7 @@ (defstruct contract-stats (sold-m2s 0) (paying-sponsors 0) - (country-sponsors (make-hash-table :test #'equal)) + (country-sponsors (make-hash-table)) (last-contracts (make-list +last-contracts-cache-size+)))

(defun initialize-contract-stats () @@ -603,8 +603,7 @@ (let* ((area (contract-area contract)) (sponsor (contract-sponsor contract)) (new-sponsor-p (alexandria:length= 1 (sponsor-contracts sponsor))) - (%country (sponsor-country sponsor)) - (country (and %country (string-upcase %country)))) + (country (sponsor-country sponsor))) (with-slots (sold-m2s paying-sponsors country-sponsors last-contracts) *contract-stats* ;; sold-m2s @@ -631,6 +630,7 @@ (contract-stats-paying-sponsors *contract-stats*))

(defun contract-stats-for-country (country) + (assert (keywordp country)) (let ((stat (gethash country (contract-stats-country-sponsors *contract-stats*)))) (if stat (values (country-stat-paying-sponsors stat) @@ -643,16 +643,12 @@ (object-destroyed-p contract))) (contract-stats-last-contracts *contract-stats*)))

-(defun invoke-with-countries (function as-keyword) - (alexandria:maphash-keys - (if as-keyword - (lambda (country) (funcall function (make-keyword-from-string country))) - function) - (contract-stats-country-sponsors *contract-stats*))) +(defun invoke-with-countries (function) + (alexandria:maphash-keys function (contract-stats-country-sponsors *contract-stats*)))

-(defmacro do-countries ((country &key as-keyword) &body body) +(defmacro do-sponsor-countries ((country) &body body) (check-type country symbol) - `(invoke-with-countries (lambda (,country) ,@body) ,as-keyword)) + `(invoke-with-countries (lambda (,country) ,@body)))

(register-store-transient-init-function 'initialize-contract-stats)

Modified: trunk/projects/bos/m2/packages.lisp =================================================================== --- trunk/projects/bos/m2/packages.lisp 2008-07-17 12:57:00 UTC (rev 3487) +++ trunk/projects/bos/m2/packages.lisp 2008-07-17 13:06:23 UTC (rev 3488) @@ -170,7 +170,7 @@ #:number-of-paying-sponsors #:contract-stats-for-country #:last-paid-contracts - #:do-countries + #:do-sponsor-countries #:make-m2-javascript #:recolorize-contracts

Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-07-17 12:57:00 UTC (rev 3487) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-07-17 13:06:23 UTC (rev 3488) @@ -154,18 +154,14 @@ (with-element "IconStyle" (with-element "Icon" ;; (with-element "href" (text "http://maps.google.com/mapfiles/kml/pal3/icon23.png")) - (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) - (dolist (country-contracts (sort (group-on (remove-if-not #'contract-paidp contracts) - :test #'equal - :key (lambda (contract) - (string-upcase (sponsor-country (contract-sponsor contract))))) - #'> :key (lambda (entry) (length (cdr entry))))) - (let ((coords (cdr (assoc (make-keyword-from-string (car country-contracts)) *country-coords*)))) + (with-element "href" (text (format nil "http://~a/static/Orang_weiss.png" (website-host))))))) + (do-sponsor-countries (country) + (let ((coords (cdr (assoc country *country-coords*)))) (when coords (destructuring-bind (lon lat) coords - (let* ((contracts (cdr country-contracts)) - (number-contracts (length contracts))) + (multiple-value-bind (number-of-paying-sponsors number-of-sold-m2s) + (contract-stats-for-country country) (with-element "Placemark" ;; (with-element "name" (text (format nil "~a ~a" (car country-contracts) (length (cdr country-contracts))))) (with-element "styleUrl" (text "#countryStatsStyle")) @@ -174,13 +170,13 @@ <tr><td>~A:</td><td>~D m²</td></tr></tbody></table>" (dictionary-entry "BOS says thank you to all sponsors!" lang) (dictionary-entry - (second (assoc (make-keyword-from-string (car country-contracts)) *country-english-names*)) lang) - number-contracts - (if (= 1 number-contracts) + (second (assoc country *country-english-names*)) lang) + number-of-paying-sponsors + (if (= 1 number-of-paying-sponsors) (dictionary-entry "sponsor" lang) (dictionary-entry "sponsors" lang)) (dictionary-entry "total contribution" lang) - (reduce #'+ contracts :key #'contract-area)))) + number-of-sold-m2s))) (with-element "Point" (with-element "coordinates" (text (format nil "~,20F,~,20F,0" lat lon)))))))))))))))