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

bknr at bknr.net bknr at bknr.net
Sat Jul 22 12:59:16 UTC 2006


Author: hhubner
Date: 2006-07-22 08:59:15 -0400 (Sat, 22 Jul 2006)
New Revision: 1971

Modified:
   branches/xml-class-rework/bknr/src/bknr.asd
   branches/xml-class-rework/bknr/src/images/image-handlers.lisp
   branches/xml-class-rework/bknr/src/packages.lisp
   branches/xml-class-rework/bknr/src/rss/rss.lisp
   branches/xml-class-rework/bknr/src/rss/test.lisp
   branches/xml-class-rework/bknr/src/web/rss-handlers.lisp
Log:
Remove old RSS handler code.


Modified: branches/xml-class-rework/bknr/src/bknr.asd
===================================================================
--- branches/xml-class-rework/bknr/src/bknr.asd	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/bknr.asd	2006-07-22 12:59:15 UTC (rev 1971)
@@ -114,7 +114,7 @@
 								 "templates"
 								 "site"
 								 "web-utils")))
-			  :depends-on ("sysclasses" "packages" "xhtmlgen"))
+			  :depends-on ("sysclasses" "packages" "xhtmlgen" "rss"))
 
 		 (:module "images" :components ((:file "image")
 						

Modified: branches/xml-class-rework/bknr/src/images/image-handlers.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/images/image-handlers.lisp	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/images/image-handlers.lisp	2006-07-22 12:59:15 UTC (rev 1971)
@@ -152,6 +152,7 @@
   (format nil "/intersection-rss/~A" (parse-url req)))
 
 ;;; rss image feeds
+#|
 (defclass rss-image-handler (object-rss-handler image-page-handler)
   ())
 
@@ -183,6 +184,7 @@
 
 (defclass rss-image-intersection-handler (rss-image-handler image-intersection-handler)
   ())
+|#
 
 (defclass xml-image-browser-handler (image-handler xml-object-handler)
   ())
@@ -210,10 +212,12 @@
   ("/image-keyword" image-keyword-handler)
   ("/image-union" image-union-handler)
   ("/image-intersection" image-intersection-handler)
+  #|
   ("/rss-image" rss-image-handler)
   ("/rss-image-keyword" rss-image-keyword-handler)
   ("/rss-image-union" rss-image-union-handler)
   ("/rss-image-intersection" rss-image-intersection-handler)
+  |#
   ("/image" imageproc-handler)
   ("/image-import" image-import-handler)
   ("/session-image" session-image-handler)

Modified: branches/xml-class-rework/bknr/src/packages.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/packages.lisp	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/packages.lisp	2006-07-22 12:59:15 UTC (rev 1971)
@@ -39,6 +39,8 @@
 
 	   ;; channel
 	   #:rss-channel
+	   #:find-rss-channel
+	   #:make-rss-channel
 	   #:rss-channel-cleanup
 	   #:rss-channel-about
 	   #:rss-channel-title
@@ -321,7 +323,6 @@
 	   #:keywords-handler
 
 	   #:rss-handler
-	   #:object-rss-handler
 
 	   #:define-bknr-webserver-module
 

Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/rss/rss.lisp	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/rss/rss.lisp	2006-07-22 12:59:15 UTC (rev 1971)
@@ -28,11 +28,17 @@
 
 ;; One rss-item can only be in one channel.
 
+;; The channel object has more required elements than the standard
+;; specifies in order to make the generated feed documents more widely
+;; accepted.
+
 ;;; Paul Graham, On Lisp, p191
 (defmacro aif (test-form then-form &optional else-form)
  `(let ((it ,test-form))
    (if it ,then-form ,else-form)))
 
+;; Class for channels
+
 (define-persistent-class rss-channel ()
   ((name :update
 	 :index-type string-unique-index
@@ -44,6 +50,14 @@
    (max-item-age :update :initform (* 7 3600))
    (items :update :initform nil)))
 
+;; Mixin for items
+
+(define-persistent-class rss-item ()
+  ((pub-date :read)))
+
+(defun make-rss-channel (name title description link &rest args)
+  (apply #'make-object 'rss-channel :name name :title title :description description :link link args))
+  
 (defun render-mandatory-element (channel element)
   (with-element (string-downcase (symbol-name element))
     (text (aif (and (slot-boundp channel element)
@@ -58,6 +72,7 @@
       (with-element "channel"
 	(dolist (slot '(title description link))
 	  (render-mandatory-element channel slot))
+	
 	(dolist (item (rss-channel-items channel))
 	  (rss-item-xml item))))))
 
@@ -96,11 +111,6 @@
 (defmethod add-item ((channel (eql nil)) (item rss-item))
   (warn "no RSS channel defined for item ~A" item))
 
-;; Mixin for items
-
-(define-persistent-class rss-item ()
-  ((pub-date :read)))
-
 (defmethod initialize-persistent-instance :after ((rss-item rss-item))
   (setf (slot-value rss-item 'pub-date) (get-universal-time))
   (add-item (rss-item-channel rss-item) rss-item))
@@ -120,7 +130,7 @@
 (defmethod rss-item-source ((rss-item rss-item)))
 
 (defun item-slot-element (item slot-name)
-  (let ((accessor (kmrcl:concat-symbol 'rss-item- slot-name)))
+  (let ((accessor (kmrcl:concat-symbol-pkg (find-package :bknr.rss) 'rss-item- slot-name)))
     (aif (funcall accessor item)
 	 (with-element (string-downcase (symbol-name slot-name))
 	   (text it)))))
@@ -131,4 +141,3 @@
       (item-slot-element item slot))
     (with-element "pubDate"
       (text (format-date-time (rss-item-pub-date item) :mail-style t)))))
-  

Modified: branches/xml-class-rework/bknr/src/rss/test.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/rss/test.lisp	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/rss/test.lisp	2006-07-22 12:59:15 UTC (rev 1971)
@@ -12,4 +12,6 @@
 (defmethod rss-item-author ((item test-item))
   "Hans Hübner")
 
-(open-store "/tmp/datastore/")
\ No newline at end of file
+(open-store "/tmp/datastore/")
+
+(start :port 8383)
\ No newline at end of file

Modified: branches/xml-class-rework/bknr/src/web/rss-handlers.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/web/rss-handlers.lisp	2006-07-22 12:58:44 UTC (rev 1970)
+++ branches/xml-class-rework/bknr/src/web/rss-handlers.lisp	2006-07-22 12:59:15 UTC (rev 1971)
@@ -1,28 +1,15 @@
 (in-package :bknr.web)
 
 ;;; rss handlers
-(defclass rss-handler (page-handler)
-  ())
+(defclass rss-handler (object-handler)
+  ()
+  (:default-initargs :query-function #'bknr.rss:find-rss-channel))
 
-(defgeneric create-rss-feed (handler req))
+(defmethod handle-object ((handler rss-handler) (channel (eql nil)) req)
+  (error "invalid channel name"))
 
-(defmethod handle ((handler rss-handler) req)
+(defmethod handle-object ((handler rss-handler) (channel bknr.rss:rss-channel) req)
   (with-bknr-http-response (req :content-type "text/xml")
     (with-http-body (req *ent*)
       (html (:princ "<?xml version=\"1.0\"?>")
-	    (write-xml
-	     (bknr.rss:rss-to-xml (create-rss-feed handler req))
-	     *html-stream* :indent t)))))
-
-(defclass object-rss-handler (object-handler rss-handler)
-  ())
-
-(defgeneric create-object-rss-feed (handler object req))
-
-(defmethod handle-object ((handler object-rss-handler) object req)
-  (with-bknr-http-response (req :content-type "text/xml")
-    (with-http-body (req *ent*)
-      (html (:princ "<?xml version=\"1.0\"?>")
-	    (write-xml
-	     (bknr.rss:rss-to-xml (create-object-rss-feed handler object req))
-	     *html-stream* :indent t)))))
+	    (bknr.rss:rss-channel-xml channel *html-stream*)))))




More information about the Bknr-cvs mailing list