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

added replace-contract-tree-placeholder U trunk/projects/bos/web/kml-handlers.lisp

Modified: trunk/projects/bos/web/kml-handlers.lisp =================================================================== --- trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 13:37:52 UTC (rev 3983) +++ trunk/projects/bos/web/kml-handlers.lisp 2008-10-13 16:21:39 UTC (rev 3984) @@ -98,11 +98,25 @@ (if (null sponsor) string (let ((contract (first (sponsor-contracts sponsor)))) - (ppcre:regex-replace #?r"<!-- +personalized +contract +placemark +-->" + (ppcre:regex-replace #?r"<!-- +personalized +contract +placemark *-->" string (cxml:with-xml-output (cxml:make-string-sink :omit-xml-declaration-p t) (write-personalized-contract-placemark-kml contract lang))))))

+(defun replace-contract-tree-placeholder (string sponsor lang) + (ppcre:regex-replace + #?r"<!-- +squaremetre +area +contract +tree +link *-->" + string + (if (and sponsor (first (sponsor-contracts sponsor))) + (let ((contract (first (sponsor-contracts sponsor))) + (node (find-contract-node *contract-tree* contract)) + (path (node-path node)) + (contract-id (store-object-id contract))) + (format nil "<href>http://~a/contract-tree-kml?rmcid=~D&rmcpath=~%7B~D~%7D&lang=~A</href>" + (website-host) contract-id path lang)) + (format nil "<href>http://~A/contract-tree-kml?lang=~A</href>" + (website-host) lang)))) + (defun serve-kml-root-data (&optional sponsor) (with-query-params ((lang "en")) (let* ((kml-root-data (kml-root-data-with-language lang)) @@ -117,7 +131,8 @@ (let ((kml-string (kml-string kml-root-data))) (setq kml-string (replace-all-url-hosts kml-string (website-host)) kml-string (replace-lang-query-params kml-string lang) - kml-string (replace-personalized-contract-placeholder kml-string sponsor lang)))))) + kml-string (replace-personalized-contract-placeholder kml-string sponsor lang) + kml-string (replace-contract-tree-placeholder kml-string sponsor lang))))))

(defmethod handle-object ((handler kml-root-handler) (object sponsor)) (serve-kml-root-data object))