- bknr-cvs@common-lisp.net - mailman3.common-lisp.net

[bknr-cvs] r1978 - in branches/xml-class-rework: bknr/src/rss projects/bos/m2 projects/bos/worldpay-test
by bknr＠bknr.net 13 Aug '06

13 Aug '06

Author: hhubner Date: 2006-08-13 09:31:52 -0400 (Sun, 13 Aug 2006) New Revision: 1978 Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp branches/xml-class-rework/projects/bos/m2/m2.lisp branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd Log: Remove the requirement to derive RSS item classes from rss-item. Make contracts into RSS items. Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp =================================================================== --- branches/xml-class-rework/bknr/src/rss/rss.lisp 2006-08-13 09:52:35 UTC (rev 1977) +++ branches/xml-class-rework/bknr/src/rss/rss.lisp 2006-08-13 13:31:52 UTC (rev 1978) @@ -57,12 +57,6 @@ (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)) @@ -96,57 +90,42 @@ ;; Internal helper functions to find a channel -(defmethod remove-item ((channel rss-channel) (item rss-item)) +(defmethod remove-item ((channel rss-channel) item) "Remove item from channel. May only be called within transaction context." (setf (slot-value channel 'items) (remove item (rss-channel-items channel)))) -(defmethod remove-item ((channel string) (item rss-item)) +(defmethod remove-item ((channel string) item) (aif (find-rss-channel channel) (remove-item it item))) -(defmethod remove-item ((channel (eql nil)) (item rss-item)) +(defmethod remove-item ((channel (eql nil)) item) (warn "no RSS channel defined for item ~A" item)) -(defmethod add-item ((channel rss-channel) (item rss-item)) +(defmethod add-item ((channel rss-channel) item) "Add item to channel. May only be called within transaction context." (setf (slot-value channel 'items) (cons item (rss-channel-items channel)))) -(defmethod add-item ((channel string) (item rss-item)) +(defmethod add-item ((channel string) item) (aif (find-rss-channel channel) (add-item it item) (warn "can't find RSS channel ~A to add newly created item ~A to" channel item))) -(defmethod add-item ((channel (eql nil)) (item rss-item)) +(defmethod add-item ((channel (eql nil)) item) (warn "no RSS channel defined for item ~A" item)) (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)) (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))) -(defmethod rss-item-description ((rss-item rss-item))) -(defmethod rss-item-author ((rss-item rss-item))) -(defmethod rss-item-category ((rss-item rss-item))) -(defmethod rss-item-comments ((rss-item rss-item))) -(defmethod rss-item-enclosure ((rss-item rss-item))) -(defmethod rss-item-guid ((rss-item rss-item))) -(defmethod rss-item-source ((rss-item rss-item))) - (defun item-slot-element (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))))) -(defmethod rss-item-xml ((item rss-item)) +(defun rss-item-xml (item) (with-element "item" (dolist (slot '(title link author category comments enclosure source)) (item-slot-element item slot)) @@ -159,3 +138,27 @@ (cdata it))) (with-element "pubDate" (text (format-date-time (rss-item-pub-date item) :mail-style t))))) + +;; All items present on an RSS stream can implement the access +;; methods below. + +(defmethod rss-item-published (item) + t) + +(defmethod rss-item-pub-date (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)) + +(defmethod rss-item-channel (item)) +(defmethod rss-item-title (item)) +(defmethod rss-item-link (item)) +(defmethod rss-item-description (item)) +(defmethod rss-item-author (item)) +(defmethod rss-item-category (item)) +(defmethod rss-item-comments (item)) +(defmethod rss-item-enclosure (item)) +(defmethod rss-item-guid (item)) +(defmethod rss-item-source (item)) + Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-08-13 09:52:35 UTC (rev 1977) +++ branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-08-13 13:31:52 UTC (rev 1978) @@ -273,13 +273,15 @@ (deftransaction do-make-contract (sponsor m2-count &key date paidp expires download-only) (let ((m2s (find-free-m2s m2-count))) (if m2s - (make-object 'contract - :sponsor sponsor - :date date - :paidp paidp - :m2s m2s - :expires expires - :download-only download-only) + (let ((contract (make-object 'contract + :sponsor sponsor + :date date + :paidp paidp + :m2s m2s + :expires expires + :download-only download-only))) + (bknr.rss::add-item "news" contract) + contract) (warn "can't create contract, ~A square meters for ~A could not be allocated" m2-count sponsor)))) (defun make-contract (sponsor m2-count Modified: branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp 2006-08-13 09:52:35 UTC (rev 1977) +++ branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp 2006-08-13 13:31:52 UTC (rev 1978) @@ -4,8 +4,7 @@ "news") (defmethod rss-item-published ((item news-item)) - (format t "Language: ~A~%" (worldpay-test::current-website-language)) - t) + (news-item-published item (worldpay-test::current-website-language))) (defmethod rss-item-title ((item news-item)) (news-item-title item (worldpay-test::current-website-language))) Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd 2006-08-13 09:52:35 UTC (rev 1977) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd 2006-08-13 13:31:52 UTC (rev 1978) @@ -35,6 +35,7 @@ (:file "tags" :depends-on ("web-utils")) (:file "news-tags" :depends-on ("web-utils")) (:file "news-rss" :depends-on ("web-utils")) + (:file "contract-rss" :depends-on ("web-utils")) (:file "worldpay-test" :depends-on ("news-tags" "tags" "map-handlers" "map-browser-handler" "poi-handlers" "boi-handlers" "contract-handlers" "sponsor-handlers" "news-handlers" "allocation-area-handlers"))

1 0

[bknr-cvs] r1977 - in branches/xml-class-rework: modules/text modules/url projects/bos projects/bos/m2 projects/bos/payment-website/templates/de projects/bos/worldpay-test thirdparty/portableaserve/aserve
by bknr＠bknr.net 13 Aug '06

13 Aug '06

Author: hhubner Date: 2006-08-13 05:52:35 -0400 (Sun, 13 Aug 2006) New Revision: 1977 Added: branches/xml-class-rework/projects/bos/payment-website/templates/de/news-extern.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_news.xml branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp Modified: branches/xml-class-rework/modules/text/blog-handlers.lisp branches/xml-class-rework/modules/url/url-handlers.lisp branches/xml-class-rework/projects/bos/build.sh branches/xml-class-rework/projects/bos/m2/m2.lisp branches/xml-class-rework/projects/bos/m2/news.lisp branches/xml-class-rework/projects/bos/m2/packages.lisp branches/xml-class-rework/projects/bos/payment-website/templates/de/quittung.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/sponsor_canceled.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_main.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_geschenk.xml branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_info.xml branches/xml-class-rework/projects/bos/worldpay-test/packages.lisp branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp branches/xml-class-rework/thirdparty/portableaserve/aserve/main.cl Log: Add RSS feed for news items Modified: branches/xml-class-rework/modules/text/blog-handlers.lisp =================================================================== --- branches/xml-class-rework/modules/text/blog-handlers.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/modules/text/blog-handlers.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -50,31 +50,6 @@ (blog-page blog grouped-articles :start-date (object-date-list-handler-date handler blog req))))) -(defclass rss-blog-handler (object-rss-handler blog-handler) - ()) - -(defmethod create-object-rss-feed ((handler rss-blog-handler) blog req) - (if blog - (let* ((site-url (website-url (page-handler-site handler))) - (url (puri:merge-uris (parse-uri (blog-name blog)) - (page-handler-url handler))) - (blog-items (mapcar #'(lambda (article) - (article-to-rss-item article :url site-url)) - (subseq (sort (blog-articles blog) - #'> :key #'article-time) - 0 20)))) - (make-instance 'rss-feed - :channel - (make-instance 'rss-channel - :about (render-uri url nil) - :title (blog-name blog) - :link (render-uri url nil) - :items (mapcar #'rss-item-link blog-items)) - :items blog-items)) - (make-instance 'rss-feed :channel (make-instance 'rss-channel - :about "no such blog" - :title "no such blog")))) - (defclass search-blog-handler (edit-object-handler blog-handler) ()) Modified: branches/xml-class-rework/modules/url/url-handlers.lisp =================================================================== --- branches/xml-class-rework/modules/url/url-handlers.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/modules/url/url-handlers.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -157,42 +157,3 @@ (format nil "/url-intersection-rss/~A" (parse-url req))) -;;; rss url feeds -(defclass rss-url-handler (object-rss-handler url-page-handler) - ()) - -(defmethod create-object-rss-feed ((handler rss-url-handler) - object req) - (let* ((site-url (website-url (page-handler-site handler))) - (url-items (mapcar #'url-submission-to-rss-item - (subseq (sort (object-list-handler-get-objects - handler object req) - #'> :key #'url-submission-date) - 0 30)))) - (if url-items - (make-instance 'rss-feed - :channel (make-instance - 'rss-channel - :about (render-uri site-url nil) - :title (object-list-handler-title - handler object req) - :link (render-uri site-url nil) - :items (mapcar #'rss-item-link url-items)) - :items url-items) - (make-instance 'rss-feed - :channel (make-instance 'rss-channel - :about "no such keyword" - :title "no such keyword"))))) - -(defclass rss-url-keyword-handler (rss-url-handler url-keyword-handler) - ()) - -(defclass rss-url-union-handler (rss-url-handler url-union-handler) - ()) - -(defclass rss-url-intersection-handler (rss-url-handler url-intersection-handler) - ()) - -(defclass rss-url-submitter-handler (rss-url-handler url-submitter-handler) - ()) - Modified: branches/xml-class-rework/projects/bos/build.sh =================================================================== --- branches/xml-class-rework/projects/bos/build.sh 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/build.sh 2006-08-13 09:52:35 UTC (rev 1977) @@ -1,20 +1,5 @@ #!/bin/sh -e -case "$1" in - --clean) - echo "deleting fasls... (use --fast to suppress)" - find .. -name \*.x86f -print0 | xargs -0 rm - ;; - --fast) - echo "not deleting fasls" - ;; - *) - echo "error: expected argument --clean or --fast" 1>&2 - exit 1 - ;; -esac - -pwd set -x (cd ../thirdparty/cl-gd && make) lisp -core cmucl.core -noinit -load load.lisp -load build.lisp Modified: branches/xml-class-rework/projects/bos/m2/m2.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/m2/m2.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -40,7 +40,8 @@ (define-persistent-class m2 () ((x :read) (y :read) - (contract :update :relaxed-object-reference t)) + (contract :update :relaxed-object-reference t) + (my-slot :read)) (:default-initargs :contract nil) (:class-indices (m2-index :index-type tiled-index :slots (x y) Modified: branches/xml-class-rework/projects/bos/m2/news.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/news.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/m2/news.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -4,7 +4,7 @@ (in-package :bos.m2) -(define-persistent-class news-item () +(define-persistent-class news-item (rss-item) ((time :read :initform (get-universal-time)) (title :none :initform (make-string-hash-table)) (text :none :initform (make-string-hash-table)))) @@ -27,9 +27,13 @@ (defmethod news-item-text ((news-item news-item) language) (slot-string news-item 'text language)) +(defun news-item-published (item language) + (and (slot-string item 'title language nil) + (slot-string item 'text language nil))) + (defun all-news-items (&optional language) (if language - (remove-if (complement #'(lambda (news-item) (and (slot-string news-item 'title language nil) - (slot-string news-item 'text language nil)))) - (store-objects-with-class 'news-item)) - (sort (copy-list (store-objects-with-class 'news-item)) #'> :key #'news-item-time))) \ No newline at end of file + (remove-if-not (lambda (item) (news-item-published item language)) + (store-objects-with-class 'news-item)) + (sort (copy-list (store-objects-with-class 'news-item)) #'> :key #'news-item-time))) + Modified: branches/xml-class-rework/projects/bos/m2/packages.lisp =================================================================== --- branches/xml-class-rework/projects/bos/m2/packages.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/m2/packages.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -34,8 +34,10 @@ :bknr.web :bknr.images :bknr.statistics + :bknr.rss :bos.m2.config :net.post-office + :cxml :cl-gd) (:shadowing-import-from :cl-interpol #:quote-meta-chars) (:export #:m2-store Added: branches/xml-class-rework/projects/bos/payment-website/templates/de/news-extern.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/news-extern.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/news-extern.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -0,0 +1,29 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<bknr:toplevel + template="toplevel_main" + title="REGENWALD für SAMBOJA LESTARI" + xmlns="http://www.w3.org/1999/xhtml" + xmlns:bknr="http://bknr.net" + xmlns:bos="http://headcraft.de/bos" + > +  + <div id="content_main"> + <div id="textbox_content"> + <bos:news-item /> + </div> + </div> + <div id="content_right"> + <div id="subscribe"> + <form style="margin:0px" name="form" method="post"> + <input value="news" name="list" type="hidden"/> + <strong>Infos direkt nach Hause? </strong><br /><br /> + Ihre E-Mail-Adresse: + <br /><br /> + <input type="text" class="form_big" name="email" size="20" maxlength="40" value="" /> + <input value="ja" class="form_big" name="action" type="submit" onclick="return send_info_request();" /> + </form> + </div> + </div> +</bknr:toplevel> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/quittung.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/quittung.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/quittung.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="/images/header_ganzneu.gif" border="0" /> </a> </div> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/sponsor_canceled.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/sponsor_canceled.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -23,7 +23,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="/images/header_ganzneu.gif" border="0" /> </a> </div> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -21,7 +21,7 @@ <div id="menue_banner"> <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="/images/header_ganzneu.gif" border="0" /> </a> </div> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_main.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_main.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_main.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -9,6 +9,8 @@ <head> <link rel="stylesheet" href="/static/toplevel_style.css" /> <link rel="stylesheet" href="/static/content_style.css" /> + <link rel="alternate" type="application/rss+xml" title="RSS Feed" + href="/rss/news" /> <script src="/static/bos.js" type="text/javascript"> </script>  @@ -19,8 +21,8 @@ <div id="header"> <div id="menue_banner"> - <a href="index"> - <img src="../images/header_ganzneu.gif" border="0" /> + <a href="/de/index"> + <img src="/images/header_ganzneu.gif" border="0" /> </a> </div> @@ -30,21 +32,21 @@ <div id="menue_header_main"> <div>l</div> <div> - <a href="idea" class="menue" + <a href="/de/idea" class="menue" title="Was genau passiert."> Projekt </a> </div> <div>l</div> <div> - <a href="bestellung" class="menue" + <a href="/de/bestellung" class="menue" title="Machen Sie mit!"> Spenden </a> </div> <div>l</div> <div> - <a href="bos" class="menue" + <a href="/de/bos" class="menue" title="BOS Foundation"> BOS </a> @@ -58,7 +60,7 @@ </div> <div>l</div> <div> - <a href="contact" class="menue" + <a href="/de/contact" class="menue" title="Kontakten Sie uns."> Kontakt </a> @@ -99,7 +101,7 @@ </td> <td colspan="2" > <img src="/images/pfeil_link_on.gif" width="10" height="9" border="0" alt="" /> - <a href="bestellung" class="content_black"> + <a href="/de/bestellung" class="content_black"> Spenden Sie! </a> </td> @@ -109,7 +111,7 @@ <tr><td colspan="3" height="5"></td></tr> <tr> <td colspan="4" valign="bottom"> - <a href="bestellung" class="content_black"> + <a href="/de/bestellung" class="content_black"> <img src="/images/spenden.jpg" width="150" height="71" border="0" alt="" /> </a> </td> @@ -178,11 +180,11 @@ </div>  <div id="menue_footer"> - <a href="javascript:window_extra('privacy')" class="footer"> + <a href="javascript:window_extra('/de/privacy')" class="footer"> Datenschutzinfo </a> l - <a href="javascript:window_extra('impressum')" class="footer"> + <a href="javascript:window_extra('/de/impressum')" class="footer"> Impressum </a> </div> Added: branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_news.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_news.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/toplevel_news.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -0,0 +1,196 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html + xmlns="http://www.w3.org/1999/xhtml" + xmlns:bknr="http://bknr.net" + xmlns:bos="http://headcraft.de/bos" + > + <head> + <link rel="stylesheet" href="/static/toplevel_style.css" /> + <link rel="stylesheet" href="/static/content_style.css" /> + <script src="/static/bos.js" type="text/javascript"> + </script> +  + <title>$(title)</title> + </head> + <body> +  + <div id="header"> + + <div id="menue_banner"> + <a href="../index"> + <img src="/images/header_ganzneu.gif" border="0" /> + </a> + </div> + + <div id="menue_header_left"> + BOS Deutschland e.V. + </div> + <div id="menue_header_main"> + <div>l</div> + <div> + <a href="idea" class="menue" + title="Was genau passiert."> + Projekt + </a> + </div> + <div>l</div> + <div> + <a href="bestellung" class="menue" + title="Machen Sie mit!"> + Spenden + </a> + </div> + <div>l</div> + <div> + <a href="bos" class="menue" + title="BOS Foundation"> + BOS + </a> + </div> + <div>l</div> + <div> + <a href="javascript:window_infosys()" class="menue" + title="Satellitenkarte"> + Satellitenkarte + </a> + </div> + <div>l</div> + <div> + <a href="contact" class="menue" + title="Kontakten Sie uns."> + Kontakt + </a> + </div> + <div>l</div> + </div> + <div id="menue_header_right" align="right"> + <select name="language" style="width:125px;" + onchange="jumpMenu('parent', this, 0)"> + <bos:language-options /> + </select> + </div> + </div> +  + +  + <div id="content"> + <div id="content_left"> +  + <div id="textbox_left_top"> + <table border="0" cellpadding="0" cellspacing="0"> + <tr> + <td colspan="4" height="10"> + </td> + </tr> + <tr> + <td width="6"> + </td> + <td colspan="2"> + <strong>Schaffen Sie Regenwald!</strong> + <br /><br /> + </td> + <td> + </td> + </tr> + <tr> + <td> + </td> + <td colspan="2" > + <img src="/images/pfeil_link_on.gif" width="10" height="9" border="0" alt="" /> + <a href="bestellung" class="content_black"> + Spenden Sie! + </a> + </td> + <td> + </td> + </tr> + <tr><td colspan="3" height="5"></td></tr> + <tr> + <td colspan="4" valign="bottom"> + <a href="bestellung" class="content_black"> + <img src="/images/spenden.jpg" width="150" height="71" border="0" alt="" /> + </a> + </td> + </tr> + <tr><td colspan="3" height="15"></td></tr> + </table> + </div> + <div id="textbox_left_down"> + <table border="0" cellpadding="0" cellspacing="0"> + <tr><td colspan="4" height="6"></td></tr> + <tr> + <td width="6"> </td> + <td colspan="2"> + <strong>Satellitenkarte</strong> + <br /></td> + <td></td> + </tr> + <tr><td colspan="3" height="5"></td></tr> + <tr> + <td></td> + <td colspan="2"> + <img src="/images/pfeil_link_on.gif" width="10" height="9" border="0" alt="" /> + <a href="javascript:window_infosys()" + class="content_black"> + Es dreht sich um m². + </a> + </td> + <td></td> + </tr> + <tr> + <td colspan="3" height="88"> + <a href="javascript:window_infosys()"> + <img src="/images/trans.gif" width="149" height="108" border="0" alt="" /> + </a> + </td> + </tr> + </table> + </div> + <div id="textbox_left_login"> + <form> + <table border="0" cellpadding="0" cellspacing="0"> + <tr><td colspan="4" height="6"></td></tr> + <tr> + <td width="6"> </td> + <td colspan="2"><strong>Sponsor-ID</strong></td> + <td width="6"></td> + </tr> + <tr> + <td width="6"> </td> + <td colspan="2"><input id="sponsorid-input" type="text" name="__sponsorid"/></td> + <td width="6"></td> + </tr> + <tr> + <td width="6"> </td> + <td colspan="2"><strong>Kennwort</strong></td> + <td width="6"></td> + </tr> + <tr> + <td width="6"> </td> + <td colspan="2"><input id="password-input" class="password-input" type="password" name="__password"/> + <img onclick="window_infosys()" class="login-button" src="/infosystem/bilder/submit.gif"/></td> + <td width="6"></td> + </tr> + </table> + </form> + </div> +  + <div id="menue_footer"> + <a href="javascript:window_extra('privacy')" class="footer"> + Datenschutzinfo + </a> + l + <a href="javascript:window_extra('impressum')" class="footer"> + Impressum + </a> + </div> +  + </div> +  + <bknr:tag-body /> +  + </div> + </body> +</html> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_geschenk.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_geschenk.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_geschenk.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -21,7 +21,7 @@  <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="/images/header_ganzneu.gif" border="0" /> </div> <div id="menue_header_left"> Modified: branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_info.xml =================================================================== --- branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_info.xml 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/payment-website/templates/de/versand_info.xml 2006-08-13 09:52:35 UTC (rev 1977) @@ -22,7 +22,7 @@ <div id="header"> <div id="menue_banner"> - <img src="../images/header_ganzneu.gif" border="0" /> + <img src="/images/header_ganzneu.gif" border="0" /> </div> <div id="menue_header_left"> Added: branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/worldpay-test/news-rss.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -0,0 +1,23 @@ +(in-package :bos.m2) + +(defmethod rss-item-channel ((item news-item)) + "news") + +(defmethod rss-item-published ((item news-item)) + (format t "Language: ~A~%" (worldpay-test::current-website-language)) + t) + +(defmethod rss-item-title ((item news-item)) + (news-item-title item (worldpay-test::current-website-language))) + +(defmethod rss-item-description ((item news-item)) + (news-item-text item (worldpay-test::current-website-language))) + +(defmethod rss-item-link ((item news-item)) + (format nil "http://createrainforest.org/~A/news-extern/~A" (worldpay-test::current-website-language) (store-object-id item))) + +(defmethod rss-item-guid ((item news-item)) + (format nil "http://createrainforest.org/~A/news-extern/~A" (worldpay-test::current-website-language) (store-object-id item))) + +(defmethod rss-item-pub-date ((item news-item)) + (news-item-time item)) Modified: branches/xml-class-rework/projects/bos/worldpay-test/packages.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/packages.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/worldpay-test/packages.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -21,6 +21,7 @@ :bknr.user :bknr.images :bknr.cron + :bknr.rss :bos.m2 :bos.m2.config) (:shadowing-import-from :cl-interpol #:quote-meta-chars) Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.asd 2006-08-13 09:52:35 UTC (rev 1977) @@ -34,6 +34,7 @@ (:file "languages-handler" :depends-on ("web-utils")) (:file "tags" :depends-on ("web-utils")) (:file "news-tags" :depends-on ("web-utils")) + (:file "news-rss" :depends-on ("web-utils")) (:file "worldpay-test" :depends-on ("news-tags" "tags" "map-handlers" "map-browser-handler" "poi-handlers" "boi-handlers" "contract-handlers" "sponsor-handlers" "news-handlers" "allocation-area-handlers")) Modified: branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp =================================================================== --- branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/projects/bos/worldpay-test/worldpay-test.lisp 2006-08-13 09:52:35 UTC (rev 1977) @@ -207,6 +207,7 @@ ("/create-contract" create-contract-handler) ("/pay-contract" pay-contract-handler) ("/cancel-contract" cancel-contract-handler) + ("/rss" rss-handler) ("/" redirect-handler :to "/index") ("/index" index-handler) Modified: branches/xml-class-rework/thirdparty/portableaserve/aserve/main.cl =================================================================== --- branches/xml-class-rework/thirdparty/portableaserve/aserve/main.cl 2006-08-13 09:48:06 UTC (rev 1976) +++ branches/xml-class-rework/thirdparty/portableaserve/aserve/main.cl 2006-08-13 09:52:35 UTC (rev 1977) @@ -23,7 +23,7 @@ ;; Suite 330, Boston, MA 02111-1307 USA ;; ;; -;; $Id: main.cl,v 1.2 2004/10/19 17:04:50 hans Exp $ +;; $Id$ ;; Description: ;; aserve's main loop @@ -2258,6 +2258,8 @@ ;; 2. name - name of the item ;; 3. filename - if type is :file then this is the filename ;; 4. content-type - if type is :file this this is the content-type + + ;; WHAT IS THIS IF IT IS NOT SHITTY CODE? I MUST BE DREAMING! (if* (and (consp header) (consp (car header))) then (let ((cd (assoc :content-disposition header :test #'eq)) (ct (assoc :content-type header :test #'eq))

1 0

[bknr-cvs] r1976 - in branches/xml-class-rework/bknr/src: . rss web
by bknr＠bknr.net 13 Aug '06

13 Aug '06

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)

1 0

[bknr-cvs] r1975 - in branches/xml-class-rework/projects/quickhoney: src website/static
by bknr＠bknr.net 23 Jul '06

23 Jul '06

Author: hhubner Date: 2006-07-23 12:07:35 -0400 (Sun, 23 Jul 2006) New Revision: 1975 Modified: branches/xml-class-rework/projects/quickhoney/src/image.lisp branches/xml-class-rework/projects/quickhoney/website/static/javascript.js Log: Add deep link support for RSS Modified: branches/xml-class-rework/projects/quickhoney/src/image.lisp =================================================================== --- branches/xml-class-rework/projects/quickhoney/src/image.lisp 2006-07-23 16:07:05 UTC (rev 1974) +++ branches/xml-class-rework/projects/quickhoney/src/image.lisp 2006-07-23 16:07:35 UTC (rev 1975) @@ -20,12 +20,6 @@ (store-object-remove-keywords image 'bknr.web::keywords '(:import))) (get-keywords-intersection-store-images '(:import)))) -(define-persistent-class quickhoney-animation-image (quickhoney-image) - ((animation :update))) - -(defmethod destroy-object :before ((image quickhoney-animation-image)) - (delete-object (quickhoney-animation-image-animation image))) - (defmethod rss-item-channel ((item quickhoney-image)) "quickhoney") @@ -36,4 +30,24 @@ (format nil "~A~@[ (Client: ~A)~]" (store-image-name image) (quickhoney-image-client image))) (defmethod rss-item-link ((image quickhoney-image)) - (format nil "http://quickhoney.com/image/~A" (store-image-name image))) \ No newline at end of file + (make-image-link image)) + +(defmethod rss-item-guid ((image quickhoney-image)) + (make-image-link image)) + +(defmethod quickhoney-image-category ((image quickhoney-image)) + (first (intersection (store-image-keywords image) '(:pixel :vector :photo :contact)))) + +(defmethod quickhoney-image-subcategory ((image quickhoney-image)) + (first (set-difference (store-image-keywords image) '(:pixel :vector :photo :button :contact :published :upload)))) + +(defmethod make-image-link ((image quickhoney-image)) + (format nil "http://quickhoney.com/index?jumpto=~(~A/~A~)/~A" + (quickhoney-image-category image) (quickhoney-image-subcategory image) (store-image-name image))) + +(define-persistent-class quickhoney-animation-image (quickhoney-image) + ((animation :update))) + +(defmethod destroy-object :before ((image quickhoney-animation-image)) + (delete-object (quickhoney-animation-image-animation image))) + Modified: branches/xml-class-rework/projects/quickhoney/website/static/javascript.js =================================================================== --- branches/xml-class-rework/projects/quickhoney/website/static/javascript.js 2006-07-23 16:07:05 UTC (rev 1974) +++ branches/xml-class-rework/projects/quickhoney/website/static/javascript.js 2006-07-23 16:07:35 UTC (rev 1975) @@ -231,7 +231,20 @@ document.getElementById("browse").style.visibility = 'hidden'; document.getElementById("results").style.visibility = 'visible'; - display_thumbnail_page(); + if (document.show_picture) { + debug('directly jump to ' + document.show_picture); + for (var i = 0; i < query_result.length; i++) { + debug('got: ' + query_result[i].name + ' want ' + document.show_picture); + if (query_result[i].name == document.show_picture) { + debug('name: ' + query_result[i].name); + display_image(i); + break; + } + } + document.show_picture = null; + } else { + display_thumbnail_page(); + } display_path(); } @@ -589,6 +602,14 @@ document.getElementById("contactimage").src = button_images['contact/contact']; } + + if (document.jump_to) { + var components = document.jump_to.split("/"); + document.jump_to = null; + show_page(components[0]); + subdirectory(components[1]); + document.show_picture = components[2]; + } } function load_button_images() { @@ -1017,6 +1038,12 @@ show_cms_window("login_form"); } + if (document.location.href.indexOf("jumpto=") != -1) { + var jump_to = document.location.href.replace(/.*jumpto=/, ""); + jump_to = jump_to.replace(/[&#].*/, ""); + document.jump_to = jump_to; + } + buttons = document.getElementById("directory").getElementsByTagName('img'); button_links = document.getElementById("directory").getElementsByTagName('a');

1 0

[bknr-cvs] r1974 - branches/xml-class-rework/projects/quickhoney/website/templates
by bknr＠bknr.net 23 Jul '06

23 Jul '06

Author: hhubner Date: 2006-07-23 12:07:05 -0400 (Sun, 23 Jul 2006) New Revision: 1974 Modified: branches/xml-class-rework/projects/quickhoney/website/templates/frontpage.xml Log: Add RSS meta tag to front page Modified: branches/xml-class-rework/projects/quickhoney/website/templates/frontpage.xml =================================================================== --- branches/xml-class-rework/projects/quickhoney/website/templates/frontpage.xml 2006-07-22 13:04:02 UTC (rev 1973) +++ branches/xml-class-rework/projects/quickhoney/website/templates/frontpage.xml 2006-07-23 16:07:05 UTC (rev 1974) @@ -8,6 +8,8 @@ > <head> <link rel="stylesheet" href="/static/styles.css" /> + <link rel="alternate" type="application/rss+xml" title="RSS Feed" + href="http://quickhoney.com/rss/quickhoney" /> <script src="/static/javascript.js" type="text/javascript"> </script> <title>QuickHoney - Nana Rausch + Peter Stemmler</title>

1 0

[bknr-cvs] r1973 - branches/xml-class-rework/thirdparty/cxml/xml
by bknr＠bknr.net 22 Jul '06

22 Jul '06

Author: hhubner Date: 2006-07-22 09:04:02 -0400 (Sat, 22 Jul 2006) New Revision: 1973 Modified: branches/xml-class-rework/thirdparty/cxml/xml/unparse.lisp Log: maybe emit start tag when generating CDATA Modified: branches/xml-class-rework/thirdparty/cxml/xml/unparse.lisp =================================================================== --- branches/xml-class-rework/thirdparty/cxml/xml/unparse.lisp 2006-07-22 13:03:32 UTC (rev 1972) +++ branches/xml-class-rework/thirdparty/cxml/xml/unparse.lisp 2006-07-22 13:04:02 UTC (rev 1973) @@ -482,6 +482,7 @@ value) (defun cdata (data) + (maybe-emit-start-tag) (sax:start-cdata *sink*) (sax:characters *sink* (rod data)) (sax:end-cdata *sink*)

1 0

[bknr-cvs] r1972 - branches/xml-class-rework/bknr/src/rss
by bknr＠bknr.net 22 Jul '06

22 Jul '06

Author: hhubner Date: 2006-07-22 09:03:32 -0400 (Sat, 22 Jul 2006) New Revision: 1972 Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp Log: Be more specific about the RSS generated, still not working for GMail clips. Modified: branches/xml-class-rework/bknr/src/rss/rss.lisp =================================================================== --- branches/xml-class-rework/bknr/src/rss/rss.lisp 2006-07-22 12:59:15 UTC (rev 1971) +++ branches/xml-class-rework/bknr/src/rss/rss.lisp 2006-07-22 13:03:32 UTC (rev 1972) @@ -70,7 +70,7 @@ (with-element "rss" (attribute "version" "2.0") (with-element "channel" - (dolist (slot '(title description link)) + (dolist (slot '(title link description)) (render-mandatory-element channel slot)) (dolist (item (rss-channel-items channel)) @@ -137,7 +137,14 @@ (defmethod rss-item-xml ((item rss-item)) (with-element "item" - (dolist (slot '(title link description author category comments enclosure guid source)) + (dolist (slot '(title link author category comments enclosure source)) (item-slot-element item slot)) + (aif (rss-item-guid item) + (with-element "guid" + (attribute "isPermaLink" "true") + (text it))) + (aif (rss-item-description item) + (with-element "description" + (cdata it))) (with-element "pubDate" (text (format-date-time (rss-item-pub-date item) :mail-style t)))))

1 0

[bknr-cvs] r1971 - in branches/xml-class-rework/bknr/src: . images rss web
by bknr＠bknr.net 22 Jul '06

22 Jul '06

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*)))))

1 0

[bknr-cvs] r1970 - in branches/xml-class-rework/projects/hello-web: . src website/templates
by bknr＠bknr.net 22 Jul '06

22 Jul '06

Author: hhubner Date: 2006-07-22 08:58:44 -0400 (Sat, 22 Jul 2006) New Revision: 1970 Added: branches/xml-class-rework/projects/hello-web/src/news.lisp branches/xml-class-rework/projects/hello-web/website/templates/index.xml branches/xml-class-rework/projects/hello-web/website/templates/user-error.xml Removed: branches/xml-class-rework/projects/hello-web/website/templates/index.bknr branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr Modified: branches/xml-class-rework/projects/hello-web/ branches/xml-class-rework/projects/hello-web/src/config.lisp branches/xml-class-rework/projects/hello-web/src/handlers.lisp branches/xml-class-rework/projects/hello-web/src/hello-web.asd branches/xml-class-rework/projects/hello-web/src/init.lisp branches/xml-class-rework/projects/hello-web/src/packages.lisp branches/xml-class-rework/projects/hello-web/src/webserver.lisp Log: Correct file endings of xml files Add RSS feed demo Property changes on: branches/xml-class-rework/projects/hello-web ___________________________________________________________________ Name: svn:ignore + datastore Modified: branches/xml-class-rework/projects/hello-web/src/config.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/config.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/config.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -3,7 +3,7 @@ ;; URL für BASE HREFs (defparameter *website-url* "http://hello-web.bknr.net") -(defparameter *root-directory* #p"home:bknr-svn/hello-web/") +(defparameter *root-directory* #p"home:bknr-svn/projects/hello-web/") (defparameter *store-directory* (merge-pathnames #p"datastore/" *root-directory*)) Modified: branches/xml-class-rework/projects/hello-web/src/handlers.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/handlers.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/handlers.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -14,4 +14,5 @@ (with-bknr-page (req :title "demo handler") (html (:p "This is the demo handler, the object id of user " (:b (:princ-safe (first (decoded-handler-path handler req)))) " is " - (:b (:princ-safe (store-object-id object))))))) \ No newline at end of file + (:b (:princ-safe (store-object-id object))))))) + Modified: branches/xml-class-rework/projects/hello-web/src/hello-web.asd =================================================================== --- branches/xml-class-rework/projects/hello-web/src/hello-web.asd 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/hello-web.asd 2006-07-22 12:58:44 UTC (rev 1970) @@ -20,7 +20,6 @@ :cl-ppcre :aserve :cxml - :cl-typesetting :mime :bknr-modules) @@ -30,4 +29,5 @@ (:file "tags" :depends-on ("config")) (:file "handlers" :depends-on ("config")) (:file "webserver" :depends-on ("handlers")) + (:file "news" :depends-on ("config")) (:file "init" :depends-on ("webserver")))) Modified: branches/xml-class-rework/projects/hello-web/src/init.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/init.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/init.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -11,6 +11,7 @@ (unless (find-user "anonymous") (make-user "anonymous") ; used for all anonymous sessions (make-user "admin" :password "admin" :full-name "Administrator" :flags '(:admin)) - (import-image "bknr-logo.png" :keywords '(:banner :bknr))) + (import-image "bknr-logo.png" :keywords '(:banner :bknr)) + (make-rss-channel "default" "BKNR Hello Web" "default RSS channel of the BKNR hello web site" *website-url*)) (publish-hello-web)) Added: branches/xml-class-rework/projects/hello-web/src/news.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/news.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/news.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -0,0 +1,23 @@ +(in-package :hello-web) + +(define-persistent-class news-item (rss-item) + ((title :read) + (text :read))) + +(defmethod rss-item-title ((item news-item)) + (news-item-title item)) + +(defmethod rss-item-description ((item news-item)) + (news-item-text item)) + +(defmethod rss-item-guid ((item news-item)) + (format nil "~A/~A" *website-url* (store-object-id item))) + +(defmethod rss-item-link ((item news-item)) + (format nil "~A/~A" *website-url* (store-object-id item))) + +(defmethod rss-item-channel ((item news-item)) + "default") + +(defun make-news-item (title text &rest args) + (apply #'make-object 'news-item :title title :text text args)) \ No newline at end of file Modified: branches/xml-class-rework/projects/hello-web/src/packages.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/packages.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/packages.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -41,6 +41,7 @@ :bknr.images :bknr.datastore :bknr.indices + :bknr.rss :hello-web.config :net.aserve :xhtml-generator) Modified: branches/xml-class-rework/projects/hello-web/src/webserver.lisp =================================================================== --- branches/xml-class-rework/projects/hello-web/src/webserver.lisp 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/src/webserver.lisp 2006-07-22 12:58:44 UTC (rev 1970) @@ -9,13 +9,12 @@ (defun publish-hello-web (&key (port *webserver-port*) (listeners 20)) - (setf bknr.web::*login-default-url* "/admin") - (make-instance 'website :name "Hello Web CMS" :handler-definitions `(("/hello-object" hello-object-handler) ("/" redirect-handler :prefix "/" :to "/index") + ("/rss" rss-handler) ("/" template-handler :prefix "/" :destination ,(namestring (merge-pathnames #p"templates/" *website-directory*)) Deleted: branches/xml-class-rework/projects/hello-web/website/templates/index.bknr =================================================================== --- branches/xml-class-rework/projects/hello-web/website/templates/index.bknr 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/website/templates/index.bknr 2006-07-22 12:58:44 UTC (rev 1970) @@ -1,22 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> -<html - xmlns="http://www.w3.org/1999/xhtml" - xmlns:bknr="http://bknr.net" - xmlns:hello-web="http://hello-web.bknr.net" - > - <head> - <link rel="stylesheet" href="/static/styles.css" /> - <script src="/static/javascript.js" type="text/javascript"> - </script> - <title>Hello Web</title> - </head> - - <body id="hello-web"> - <h2>Hello Web!</h2> - <hello-web:test-tag arg="blub" /> - <h2>Handler demo</h2> - <a href="/hello-object/anonymous">see the output of a user-defined handler</a> - </body> -</html> Copied: branches/xml-class-rework/projects/hello-web/website/templates/index.xml (from rev 1969, branches/xml-class-rework/projects/hello-web/website/templates/index.bknr) Deleted: branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr =================================================================== --- branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr 2006-07-22 12:58:44 UTC (rev 1970) @@ -1,14 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> -<html - xmlns="http://www.w3.org/1999/xhtml" - xmlns:bknr="http://bknr.net" - xmlns:lisp-ecoop05="http://lisp-ecoop05.bknr.net" - xmlns:menu="http://bknr.net/menu" - > -Your request could not be processed because an error occured: -<pre> -$(error-message) -</pre> -</html> \ No newline at end of file Copied: branches/xml-class-rework/projects/hello-web/website/templates/user-error.xml (from rev 1969, branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr) =================================================================== --- branches/xml-class-rework/projects/hello-web/website/templates/user-error.bknr 2006-07-22 11:30:36 UTC (rev 1969) +++ branches/xml-class-rework/projects/hello-web/website/templates/user-error.xml 2006-07-22 12:58:44 UTC (rev 1970) @@ -0,0 +1,14 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html + xmlns="http://www.w3.org/1999/xhtml" + xmlns:bknr="http://bknr.net" + xmlns:lisp-ecoop05="http://lisp-ecoop05.bknr.net" + xmlns:menu="http://bknr.net/menu" + > +Your request could not be processed because an error occured: +<p> +$(error-message) +</p> +</html> \ No newline at end of file

1 0

[bknr-cvs] r1969 - in branches/xml-class-rework/projects/quickhoney: src website/templates
by bknr＠bknr.net 22 Jul '06

22 Jul '06

Author: hhubner Date: 2006-07-22 07:30:36 -0400 (Sat, 22 Jul 2006) New Revision: 1969 Modified: branches/xml-class-rework/projects/quickhoney/src/image.lisp branches/xml-class-rework/projects/quickhoney/src/packages.lisp branches/xml-class-rework/projects/quickhoney/website/templates/index.xml Log: fix wrong input name for client input while uploading images. add rss feed for new images, frontend not yet done. Modified: branches/xml-class-rework/projects/quickhoney/src/image.lisp =================================================================== --- branches/xml-class-rework/projects/quickhoney/src/image.lisp 2006-07-22 11:29:38 UTC (rev 1968) +++ branches/xml-class-rework/projects/quickhoney/src/image.lisp 2006-07-22 11:30:36 UTC (rev 1969) @@ -1,6 +1,6 @@ (in-package :quickhoney) -(define-persistent-class quickhoney-image (store-image) +(define-persistent-class quickhoney-image (store-image rss-item) ((client :update :initform "" :index-type hash-index :index-initargs (:test #'equal) :index-reader images-for-client @@ -24,4 +24,16 @@ ((animation :update))) (defmethod destroy-object :before ((image quickhoney-animation-image)) - (delete-object (quickhoney-animation-image-animation image))) \ No newline at end of file + (delete-object (quickhoney-animation-image-animation image))) + +(defmethod rss-item-channel ((item quickhoney-image)) + "quickhoney") + +(defmethod rss-item-title ((image quickhoney-image)) + (store-image-name image)) + +(defmethod rss-item-description ((image quickhoney-image)) + (format nil "~A~@[ (Client: ~A)~]" (store-image-name image) (quickhoney-image-client image))) + +(defmethod rss-item-link ((image quickhoney-image)) + (format nil "http://quickhoney.com/image/~A" (store-image-name image))) \ No newline at end of file Modified: branches/xml-class-rework/projects/quickhoney/src/packages.lisp =================================================================== --- branches/xml-class-rework/projects/quickhoney/src/packages.lisp 2006-07-22 11:29:38 UTC (rev 1968) +++ branches/xml-class-rework/projects/quickhoney/src/packages.lisp 2006-07-22 11:30:36 UTC (rev 1969) @@ -29,6 +29,7 @@ :bknr.datastore :bknr.indices :bknr.images + :bknr.rss :quickhoney.config :net.aserve :xhtml-generator) Modified: branches/xml-class-rework/projects/quickhoney/website/templates/index.xml =================================================================== --- branches/xml-class-rework/projects/quickhoney/website/templates/index.xml 2006-07-22 11:29:38 UTC (rev 1968) +++ branches/xml-class-rework/projects/quickhoney/website/templates/index.xml 2006-07-22 11:30:36 UTC (rev 1969) @@ -147,7 +147,7 @@ </p> <p class="cms"> Client:<br /> - <input type="text" id="upload_client" name="upload_client" value="" /><br /> + <input type="text" id="upload_client" name="client" value="" /><br /> <div id="upload_client_select"> </div> </p> @@ -194,7 +194,7 @@ </p> <p class="cms"> Client:<br /> - <input type="text" id="upload_client" name="upload_client" value="" /><br /> + <input type="text" id="upload_client" name="client" value="" /><br /> <div id="upload_animation_client_select"> </div> </p>

1 0