Changeset 3701

Timestamp:

07/30/08 23:06:43 (4 months ago)

Author:

hans

Message:

Work on JSON handler for news.

Files:

• trunk/projects/quickhoney/src/handlers.lisp (modified) (2 diffs)
• trunk/projects/quickhoney/src/image.lisp (modified) (3 diffs)
• trunk/projects/quickhoney/src/news.lisp (added)
• trunk/projects/quickhoney/src/quickhoney.asd (modified) (1 diff)
• trunk/projects/quickhoney/src/webserver.lisp (modified) (1 diff)

trunk/projects/quickhoney/src/handlers.lisp

@@ -314 +314 @@
-                               "function done() { window.opener.do_query(); window.close(); }"))
-                             (:body
-
+
+
-                              (:p ((:img :src (format nil "/image/~D" (store-object-id image))
-                                         :width (round (* ratio width)) :height (round (* ratio height)))))
@@ -425 +426 @@
-                      (: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))))))))

trunk/projects/quickhoney/src/image.lisp

@@ -8 +8 @@
-   (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)
@@ -48 +22 @@
-            (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))
@@ -82 +41 @@
-  (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)))

trunk/projects/quickhoney/src/quickhoney.asd

@@ -30 +30 @@
-               (: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"))

trunk/projects/quickhoney/src/webserver.lisp

@@ -34 +34 @@
-                                        ("/upload-news" upload-news-handler)
-                                        ("/digg-image" digg-image-handler)
+                                        ("/news-json" news-json-handler)
-                                        ("/" template-handler
-                                         :default-template "frontpage"