Revision: 3701 Author: hans URL: http://bknr.net/trac/changeset/3701

Work on JSON handler for news.

U trunk/projects/quickhoney/src/handlers.lisp U trunk/projects/quickhoney/src/image.lisp A trunk/projects/quickhoney/src/news.lisp U trunk/projects/quickhoney/src/quickhoney.asd U trunk/projects/quickhoney/src/webserver.lisp

Modified: trunk/projects/quickhoney/src/handlers.lisp =================================================================== --- trunk/projects/quickhoney/src/handlers.lisp 2008-07-30 15:30:19 UTC (rev 3700) +++ trunk/projects/quickhoney/src/handlers.lisp 2008-07-30 21:06:43 UTC (rev 3701) @@ -313,7 +313,8 @@ ((:script :type "text/javascript" :language "JavaScript") "function done() { window.opener.do_query(); window.close(); }")) (:body - (:p "Image " (:princ-safe (store-image-name image)) " with " (:princ-safe (hash-table-count color-table)) " colors uploaded") + (:p "Image " (:princ-safe (store-image-name image)) " with " + (:princ-safe (hash-table-count color-table)) " colors uploaded") (:p ((:img :src (format nil "/image/~D" (store-object-id image)) :width (round (* ratio width)) :height (round (* ratio height))))) (:p ((:a :href "javascript:done()") "ok"))))))))))) @@ -424,3 +425,56 @@ (:p "Error during upload:") (:p (:princ-safe (apply #'format nil (simple-condition-format-control e) (simple-condition-format-arguments e)))) (:p ((:a :href "javascript:window.close()") "ok")))))))))))) + +(defclass news-json-handler (object-handler) + () + (:default-initargs :object-class 'rss-channel :query-function #'find-rss-channel)) + +(defvar *json-output*) + +(defmacro with-json-output ((stream) &body body) + `(let ((*json-output* ,stream)) + ,@body)) + +(defmacro with-json-output-to-string (() &body body) + `(with-output-to-string (*json-output*) + ,@body)) + +(defmacro with-json-array (() &body body) + (with-gensyms (need-comma) + `(let (,need-comma) + (princ #[ *json-output*) + (prog1 + (labels ((encode-array-element (value) + (if ,need-comma + (princ #, *json-output*) + (setf ,need-comma t)) + (json:encode-json value *json-output*))) + ,@body) + (princ #] *json-output*))))) + +(defmacro with-json-object (() &body body) + (with-gensyms (need-comma) + `(let (,need-comma) + (princ #{ *json-output*) + (prog1 + (labels ((encode-object-member (key value) + (when value + (if ,need-comma + (princ #, *json-output*) + (setf ,need-comma t)) + (json:encode-json key *json-output*) + (princ #, *json-output*) + (json:encode-json value *json-output*)))) + ,@body) + (princ #} *json-output*))))) + +(defmethod handle-object ((handler news-json-handler) (channel rss-channel)) + (with-http-response (:content-type "application/json") + (with-json-output-to-string () + (with-json-array () + (dolist (item (rss-channel-items channel)) + (with-json-object () + (encode-object-member "pubDate" (format-date-time (rss-item-pub-date item) :vms-style t)) + (encode-object-member "title" (rss-item-title item)) + (encode-object-member "description" (rss-item-description item)))))))) \ No newline at end of file

Modified: trunk/projects/quickhoney/src/image.lisp =================================================================== --- trunk/projects/quickhoney/src/image.lisp 2008-07-30 15:30:19 UTC (rev 3700) +++ trunk/projects/quickhoney/src/image.lisp 2008-07-30 21:06:43 UTC (rev 3701) @@ -8,32 +8,6 @@ (spider-keywords :update :initform nil) (products :update :initform nil)))

-(defmethod rss-item-pub-date ((item quickhoney-image)) - (blob-timestamp item)) - -(defmethod quickhoney-image-explicit ((image quickhoney-image)) - (member :explicit (store-image-keywords image))) - -(defmethod rss-item-encoded-content ((image quickhoney-image)) - (let* ((category (first (intersection (store-image-keywords image) '(:vector :pixel)))) - (is-vector (eq category :vector))) - (with-output-to-string (s) - (html-stream - s - ((:div :class (format nil "newsentry news_~(~A~)" category)) - ((:img :src (format nil "http://~A/image/~A/cutout-button,,~A,98,4" - (website-host) - (store-object-id image) - (if is-vector "00ccff" "ff00ff"))) - (:div - (:h1 (:princ (store-image-name image))) - (:princ (format nil "~A by ~A | " - (format-date-time (blob-timestamp image)) - (if is-vector "Peter" "Nana"))) - ((:a :href (make-image-link image)) "permalink"))))) - (when (quickhoney-image-client image) - (html-stream s :br "Client: " (:princ (quickhoney-image-client image))))))) - (defvar *last-image-upload-timestamp* 0)

(defmethod initialize-transient-instance :after ((image quickhoney-image)) @@ -48,21 +22,6 @@ (store-object-remove-keywords image 'bknr.web::keywords '(:import))) (get-keywords-intersection-store-images '(:import))))

-(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)) - (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 :news :contact))))

@@ -81,27 +40,3 @@ (defmethod destroy-object :before ((image quickhoney-animation-image)) (delete-object (quickhoney-animation-image-animation image)))

-(define-persistent-class quickhoney-news-item (quickhoney-image) - ((title :update) - (text :update))) - -(defmethod quickhoney-image-spider-keywords ((item quickhoney-news-item)) - (quickhoney-news-item-title item)) - -(defmethod rss-item-title ((item quickhoney-news-item)) - (quickhoney-news-item-title item)) - -(defmethod rss-item-encoded-content ((item quickhoney-news-item)) - (concatenate 'string - (call-next-method) - (quickhoney-news-item-text item))) - -(defclass quickhoney-rss-channel (rss-channel) - () - (:metaclass persistent-class)) - -(defmethod rss-channel-items ((channel quickhoney-rss-channel) &key) - (remove-if (lambda (item) - (and (typep item 'quickhoney-image) - (quickhoney-image-explicit item))) - (call-next-method))) \ No newline at end of file

Added: trunk/projects/quickhoney/src/news.lisp =================================================================== --- trunk/projects/quickhoney/src/news.lisp (rev 0) +++ trunk/projects/quickhoney/src/news.lisp 2008-07-30 21:06:43 UTC (rev 3701) @@ -0,0 +1,68 @@ +(in-package :quickhoney) + +(defmethod rss-item-pub-date ((item quickhoney-image)) + (blob-timestamp item)) + +(defmethod quickhoney-image-explicit ((image quickhoney-image)) + (member :explicit (store-image-keywords image))) + +(defmethod rss-item-encoded-content ((image quickhoney-image)) + (let* ((category (first (intersection (store-image-keywords image) '(:vector :pixel)))) + (is-vector (eq category :vector))) + (with-output-to-string (s) + (html-stream + s + ((:div :class (format nil "newsentry news_~(~A~)" category)) + ((:img :src (format nil "http://~A/image/~A/cutout-button,,~A,98,4" + (website-host) + (store-object-id image) + (if is-vector "00ccff" "ff00ff"))) + (:div + (:h1 (:princ (store-image-name image))) + (:princ (format nil "~A by ~A | " + (format-date-time (blob-timestamp image)) + (if is-vector "Peter" "Nana"))) + ((:a :href (make-image-link image)) "permalink"))))) + (when (quickhoney-image-client image) + (html-stream s :br "Client: " (:princ (quickhoney-image-client 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)) + (make-image-link image)) + +(defmethod rss-item-guid ((image quickhoney-image)) + (make-image-link image)) + +(define-persistent-class quickhoney-news-item (quickhoney-image) + ((title :update) + (text :update))) + +(defmethod quickhoney-image-spider-keywords ((item quickhoney-news-item)) + (quickhoney-news-item-title item)) + +(defmethod rss-item-title ((item quickhoney-news-item)) + (quickhoney-news-item-title item)) + +(defmethod rss-item-encoded-content ((item quickhoney-news-item)) + (concatenate 'string + (call-next-method) + (quickhoney-news-item-text item))) + +(defclass quickhoney-rss-channel (rss-channel) + () + (:metaclass persistent-class)) + +(defmethod rss-channel-items ((channel quickhoney-rss-channel) &key) + (remove-if (lambda (item) + (and (typep item 'quickhoney-image) + (quickhoney-image-explicit item))) + (call-next-method))) +

Modified: trunk/projects/quickhoney/src/quickhoney.asd =================================================================== --- trunk/projects/quickhoney/src/quickhoney.asd 2008-07-30 15:30:19 UTC (rev 3700) +++ trunk/projects/quickhoney/src/quickhoney.asd 2008-07-30 21:06:43 UTC (rev 3701) @@ -29,6 +29,7 @@ :components ((:file "packages") (:file "config" :depends-on ("packages")) (:file "image" :depends-on ("config")) + (:file "news" :depends-on ("image")) (:file "layout" :depends-on ("config")) (:file "imageproc" :depends-on ("config")) (:file "handlers" :depends-on ("layout" "config" "image"))

Modified: trunk/projects/quickhoney/src/webserver.lisp =================================================================== --- trunk/projects/quickhoney/src/webserver.lisp 2008-07-30 15:30:19 UTC (rev 3700) +++ trunk/projects/quickhoney/src/webserver.lisp 2008-07-30 21:06:43 UTC (rev 3701) @@ -33,6 +33,7 @@ ("/admin" admin-handler) ("/upload-news" upload-news-handler) ("/digg-image" digg-image-handler) + ("/news-json" news-json-handler) ("/" template-handler :default-template "frontpage" :destination ,(namestring (merge-pathnames "templates/" *website-directory*))