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

[BKNR Commits]

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

added handlers /sitemap.xml and /contract-placemark for Google crawler

U   trunk/projects/bos/web/contract-tree.lisp
U   trunk/projects/bos/web/webserver.lisp

Modified: trunk/projects/bos/web/contract-tree.lisp
===================================================================
--- trunk/projects/bos/web/contract-tree.lisp	2008-09-09 15:57:45 UTC (rev 3870)
+++ trunk/projects/bos/web/contract-tree.lisp	2008-09-09 17:41:22 UTC (rev 3871)
@@ -132,7 +132,64 @@
      (hunchentoot:handle-if-modified-since (timestamp node))
      , at body))
 
-;;; kml handler
+;;; contract-placemark-handler
+(defclass contract-placemark-handler (object-handler)
+  ()
+  (:default-initargs :object-class 'contract)
+  (:documentation "Publishes a contract as a kml placemark to be
+crawled by Google."))
+
+(defmethod handle-object ((handler contract-placemark-handler) contract
+                          &aux (last-change (store-object-last-change contract 0)))
+  (hunchentoot:handle-if-modified-since last-change)
+  (setf (hunchentoot:header-out :last-modified)
+        (hunchentoot:rfc-1123-date last-change))
+  (let ((name (user-full-name (contract-sponsor contract))))
+    (with-xml-response (:content-type "application/vnd.google-earth.kml+xml")
+      (with-namespace (nil "http://www.opengis.net/kml/2.2")
+        (with-namespace ("atom" "http://www.w3.org/2005/Atom")
+          (with-element "kml"
+            (with-element "Document"
+              (when name (with-element "name" (text name)))
+              (with-element* ("atom" "author")
+                (with-element* ("atom" "name")
+                  (text "BOS Deutschland e.V. - Borneo Orangutan Survival Deutschland")))
+              (with-element* ("atom" "link")
+                (attribute "href" (format nil "http://~A" (website-host))))
+              (with-element "Placemark"                          
+                (when name (with-element "name" (text name)))
+                (with-element "Snippet"
+                  (attribute "maxLines" "2")
+                  (text (format-date-time (contract-date contract) :show-time nil))
+                  (with-element "br")
+                  (text (format nil "~D m²" (contract-area contract))))
+                (with-element "description" (cdata (contract-description contract "en")))
+                (with-element "Point"
+                  (with-element "coordinates"
+                    (destructuring-bind (x y)
+                        (contract-center contract)
+                      (text (with-output-to-string (out)
+                              (kml-format-point (make-point :x x :y y) out))))))))))))))
+
+;;; sitemap-handler
+(defclass sitemap-handler (page-handler)
+  ())
+
+(defmethod handle ((handler sitemap-handler))
+  (with-xml-response ()
+    (with-namespace (nil "http://www.sitemaps.org/schemas/sitemap/0.9")
+      (with-namespace ("geo" "http://www.google.com/geo/schemas/sitemap/1.0")
+        (with-element "urlset"
+          (dolist (contract (class-instances 'contract))
+            (when (user-full-name (contract-sponsor contract))
+              (with-element "url"
+                (with-element "loc"
+                  (text (format nil "http://~A/contract-placemark/~D"
+                                (website-host) (store-object-id contract))))
+                (with-element* ("geo" "geo")
+                  (with-element* ("geo" "format") (text "kml")))))))))))
+
+;;; contract-tree-kml-handler
 (defclass contract-tree-kml-handler (page-handler)
   ()
   (:documentation "Generates a kml representation of the queried

Modified: trunk/projects/bos/web/webserver.lisp
===================================================================
--- trunk/projects/bos/web/webserver.lisp	2008-09-09 15:57:45 UTC (rev 3870)
+++ trunk/projects/bos/web/webserver.lisp	2008-09-09 17:41:22 UTC (rev 3871)
@@ -163,6 +163,8 @@
                                         ("/kml-root-dynamic" kml-root-dynamic-handler)
                                         ("/kml-root" kml-root-handler)
                                         ("/country-stats" country-stats-handler)
+                                        ("/sitemap.xml" sitemap-handler)
+                                        ("/contract-placemark" contract-placemark-handler)
                                         ("/contract-tree-kml" contract-tree-kml-handler)
                                         ("/contract-tree-image" contract-tree-image-handler)
                                         ("/contract-image" contract-image-handler)