[bknr-cvs] r1976 - in branches/xml-class-rework/bknr/src: . rss web

[bknr at bknr.net]

Author: hhubner
Date: 2006-08-13 05:48:06 -0400 (Sun, 13 Aug 2006)
New Revision: 1976

Modified:
   branches/xml-class-rework/bknr/src/packages.lisp
   branches/xml-class-rework/bknr/src/rss/rss.lisp
   branches/xml-class-rework/bknr/src/web/handlers.lisp
Log:
Reworked RSS generation.


Modified: branches/xml-class-rework/bknr/src/packages.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/packages.lisp	2006-07-23 16:07:35 UTC (rev 1975)
+++ branches/xml-class-rework/bknr/src/packages.lisp	2006-08-13 09:48:06 UTC (rev 1976)
@@ -61,6 +61,8 @@
 	   ;; item
 	   #:rss-item
 	   #:rss-item-channel
+	   #:rss-item-published
+	   #:rss-item-pub-date
 	   #:rss-item-title
 	   #:rss-item-link
 	   #:rss-item-description

Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/rss/rss.lisp	2006-07-23 16:07:35 UTC (rev 1975)
+++ branches/xml-class-rework/bknr/src/rss/rss.lisp	2006-08-13 09:48:06 UTC (rev 1976)
@@ -47,14 +47,22 @@
    (link :update)
    (description :update)
    (last-update :update :initform (get-universal-time))
-   (max-item-age :update :initform (* 7 3600))
+   (max-item-age :update :initform (* 4 7 3600))
    (items :update :initform nil)))
 
 ;; Mixin for items
 
 (define-persistent-class rss-item ()
-  ((pub-date :read)))
+  ())
 
+(defgeneric rss-item-pub-date (item))
+
+(defmethod rss-item-pub-date ((item rss-item))
+  "The default implementation for the publication date delivers the
+current system date/time as publication date."
+  (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item))
+  (get-universal-time))
+
 (defun make-rss-channel (name title description link &rest args)
   (apply #'make-object 'rss-channel :name name :title title :description description :link link args))
   
@@ -73,7 +81,7 @@
 	(dolist (slot '(title link description))
 	  (render-mandatory-element channel slot))
 	
-	(dolist (item (rss-channel-items channel))
+	(dolist (item (remove-if-not #'rss-item-published (rss-channel-items channel)))
 	  (rss-item-xml item))))))
 
 (defmethod rss-channel-items ((channel rss-channel))
@@ -118,6 +126,9 @@
 (defmethod destroy-object :before ((rss-item rss-item))
   (remove-item (rss-item-channel rss-item) rss-item))
 
+(defmethod rss-item-published ((rss-item rss-item))
+  t)
+
 (defmethod rss-item-channel ((rss-item rss-item)))
 (defmethod rss-item-title ((rss-item rss-item)))
 (defmethod rss-item-link ((rss-item rss-item)))

Modified: branches/xml-class-rework/bknr/src/web/handlers.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/handlers.lisp	2006-07-23 16:07:35 UTC (rev 1975)
+++ branches/xml-class-rework/bknr/src/web/handlers.lisp	2006-08-13 09:48:06 UTC (rev 1976)
@@ -231,11 +231,13 @@
 	  (setf (session-variable :login-redirect-uri)
 		(redirect-uri (request-uri req)))
 	  (redirect (website-make-path *website* "login") req))
-	(handler-bind ((error #'(lambda (e)
-                                  (funcall (website-show-error-page-function *website*) e)
-				  (do-error-log-request req e)
-				  (error e))))
-	  (handle handler req)))
+	(if (member :notrap net.aserve::*debug-current* :test #'eq)
+	    (handle handler req)
+	    (handler-bind ((error #'(lambda (e)
+				      (funcall (website-show-error-page-function *website*) e)
+				      (do-error-log-request req e)
+				      (error e))))
+	      (handle handler req))))
     (handler-case
 	(mapcar #'delete-file (mapcar #'cdr (request-uploaded-files req)))
       (error (e)