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)