Add action “sitemap”.

Ignore-this: df94e19d8c627a7270d261d85ca535ba

darcs-hash:e684aef65cbe3a8b8cb35656a26859611bd8b50d

2 files changed, 29 insertions, 2 deletions

diff --git a/journal.lisp b/journal.lisp
index 6f6c5a6..face2a2 100755
--- a/journal.lisp
+++ b/journal.lisp
@@ -762,6 +762,22 @@
                  (<:p "Type " (<:em (<:as-html (type-of y))) ".")
                  (<:pre (<:as-html (prin1-to-string y))))))))
 
+(defun show-site-map ()
+  (with-xml-output (*standard-output* :encoding "utf-8")
+    (with-tag ("sitemap" '(("xmlns" "http://www.sitemaps.org/schemas/sitemap/0.9")))
+      (with-tag ("url")
+        (emit-simple-tags :loc (link-to :index)
+                          :priority "0.5"))
+      (with-tag ("url")
+        (emit-simple-tags :loc (link-to :full-index)
+                          :priority "0.3"))
+      (dolist (id (select [slot-value 'journal-entry 'id]
+                          :from [journal-entry]
+                          :flatp t))
+        (with-tag ("url")
+          (emit-simple-tags :loc (link-to :view :post-id id)
+                            :priority "0.7"))))))
+
 (defun update-journal ()
   (format t "~&Updating index page...")
   (update-index-page)
@@ -769,7 +785,9 @@
   (update-all-journal-entry-pages)
   (format t "~&Updating the news feeds...")
   (update-atom-feed)
-  (update-comment-feed))
+  (update-comment-feed)
+  (format t "~&Updating the site map...")
+  (update-site-map))
 
 (defun update-index-page ()
   (let ((file-path (merge-pathnames "index.xhtml" *static-dir*)))
@@ -806,3 +824,9 @@
     (with-open-file (*standard-output* file-path :direction :output :if-exists :supersede)
       (let ((*mode* :file))
         (show-comment-feed)))))
+
+(defun update-site-map ()
+  (let ((file-path (merge-pathnames "sitemap.xml" *static-dir*)))
+    (with-open-file (*standard-output* file-path :direction :output :if-exists :supersede)
+      (let ((*mode* :file))
+        (show-site-map)))))
diff --git a/main.lisp b/main.lisp
index 42eda2c..34085a6 100644
--- a/main.lisp
+++ b/main.lisp
@@ -48,6 +48,7 @@
                                       ((string= "moderate" (car (last *subpath*))) :moderate)
                                       ((string= "atom" (car (last *subpath*))) :view-atom-entry)
                                       ((string= "rebuild" (car (last *subpath*))) :rebuild)
+                                      ((string= "sitemap" (car (last *subpath*))) :sitemap)
                                       ((member (car (last *subpath*)) '("rpc" "RPC2") :test #'string=) :xml-rpc)
                                       (t nil))))
          (*query*           (if (member *action* '(:view-atom-entry :xml-rpc))
@@ -148,7 +149,8 @@
                      ;; Update static files.
                      (update-index-page)
                      (update-journal-entry-page entry)
-                     (update-atom-feed)))
+                     (update-atom-feed)
+                     (update-site-map)))
                  (show-web-journal))
     (:moderate (let* ((id (getf *query* :id nil))
                       (type (getf *query* :type nil))
@@ -342,6 +344,7 @@
                        :pretty nil
                        :escape nil
                        :stream *standard-output*)))
+    (:sitemap (show-site-map))
     (otherwise (show-web-journal)))
   #.(restore-sql-reader-syntax-state))