[bknr-cvs] ksprotte changed trunk/projects/bos/

[BKNR Commits]

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) , at body) ,as-keyword))
+  `(invoke-with-countries (lambda (,country) , at 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)))))))))))))))