Changeset 3702

Show
Ignore:
Timestamp:
07/31/08 08:18:02 (4 months ago)
Author:
hans
Message:

Add streaming JSON encoding infrastructure and handler for news.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/web/src/rss/rss.lisp

    r3694 r3702  
    118118        (parse-integer days-string))))) 
    119119 
     120(defun month-from-query-parameter () 
     121  (when (boundp 'hunchentoot:*request*) 
     122    (let ((month-string (bknr.web:query-param "month"))) 
     123      (when month-string 
     124        (mapcar #'parse-integer (cl-ppcre:split "([-/]|(?<=..))" month-string :limit 2)))))) 
     125 
    120126(defun rss-channel-archive (channel) 
    121127  "Return the channel archive consisting of lists of lists ((MONTH YEAR) ITEM...)" 
    …… 
    130136(defgeneric rss-channel-items (channel &key) 
    131137  (:documentation "Return all non-expired items in channel.") 
    132   (:method ((channel rss-channel) &key days month) 
    133     (cond 
    134       (month 
    135        (cdr (find month (rss-channel-archive channel) :test #'equal))) 
    136       (t 
    137        (let* ((days (or days 
    138                         (days-from-query-parameter) 
    139                         (rss-channel-max-item-age channel))) 
    140               (expiry-time (- (get-universal-time) (* 60 60 25 days)))) 
    141          (remove-if (lambda (item) (or (object-destroyed-p item) 
    142                                        (< (rss-item-pub-date item) expiry-time))) 
    143                     (slot-value channel 'items))))))) 
     138  (:method ((channel rss-channel) &key days month count) 
     139    (unless month 
     140      (setf month (month-from-query-parameter))) 
     141    (unless days 
     142      (setf days (or (days-from-query-parameter) 
     143                     (rss-channel-max-item-age channel)))) 
     144    (let ((items (if month 
     145                     (cdr (find month (rss-channel-archive channel) :test #'equal)) 
     146                     (let ((expiry-time (- (get-universal-time) (* 60 60 24 days)))) 
     147                       (remove-if (lambda (item) (or (object-destroyed-p item) 
     148                                                     (< (rss-item-pub-date item) expiry-time))) 
     149                                  (slot-value channel 'items)))))) 
     150      (if count 
     151          (subseq items 0 (min count (length items))) 
     152          items)))) 
    144153 
    145154(defgeneric rss-channel-archived-months (channel) 

  • trunk/projects/quickhoney/src/handlers.lisp

    r3701 r3702  
    433433(defvar *json-output*) 
    434434 
     435(defclass json-output-stream () 
     436  ((stream :reader stream 
     437           :initarg :stream) 
     438   (stack :accessor stack 
     439          :initform nil))) 
     440 
     441(defun next-aggregate-element () 
     442  (if (car (stack *json-output*)) 
     443      (princ #\, (stream *json-output*)) 
     444      (setf (car (stack *json-output*)) t))) 
     445 
    435446(defmacro with-json-output ((stream) &body body) 
    436   `(let ((*json-output* ,stream)) 
     447  `(let ((*json-output* (make-instance 'json-output-stream :stream ,stream))) 
    437448     ,@body)) 
    438449 
    439450(defmacro with-json-output-to-string (() &body body) 
    440   `(with-output-to-string (*json-output*) 
     451  `(with-output-to-string (s) 
     452     (with-json-output (s) 
     453       ,@body))) 
     454 
     455(defmacro with-json-aggregate ((begin-char end-char) &body body) 
     456  `(progn 
     457     (when (stack *json-output*) 
     458       (next-aggregate-element)) 
     459     (princ ,begin-char (stream *json-output*)) 
     460     (push nil (stack *json-output*)) 
     461     (prog1 
     462         (progn ,@body) 
     463       (pop (stack *json-output*)) 
     464       (princ ,end-char (stream *json-output*))))) 
     465 
     466(defmacro with-json-array (() &body body) 
     467  `(with-json-aggregate (#\[ #\]) 
    441468     ,@body)) 
    442469 
    443 (defmacro with-json-array (() &body body) 
    444   (with-gensyms (need-comma) 
    445     `(let (,need-comma) 
    446        (princ #\[ *json-output*) 
    447        (prog1 
    448            (labels ((encode-array-element (value) 
    449                       (if ,need-comma 
    450                           (princ #\, *json-output*) 
    451                           (setf ,need-comma t)) 
    452                       (json:encode-json value *json-output*))) 
    453              ,@body) 
    454          (princ #\] *json-output*))))) 
    455  
    456470(defmacro with-json-object (() &body body) 
    457   (with-gensyms (need-comma) 
    458     `(let (,need-comma) 
    459        (princ #\{ *json-output*) 
    460        (prog1 
    461            (labels ((encode-object-member (key value) 
    462                       (when value 
    463                         (if ,need-comma 
    464                             (princ #\, *json-output*) 
    465                             (setf ,need-comma t)) 
    466                         (json:encode-json key *json-output*) 
    467                         (princ #\, *json-output*) 
    468                         (json:encode-json value *json-output*)))) 
    469              ,@body) 
    470          (princ #\} *json-output*))))) 
     471  `(with-json-aggregate (#\{ #\}) 
     472     ,@body)) 
     473 
     474(defun encode-array-element (object) 
     475  (next-aggregate-element) 
     476  (json:encode-json object (stream *json-output*))) 
     477 
     478(defun encode-object-element (key value) 
     479  (next-aggregate-element) 
     480  (json:encode-json key (stream *json-output*)) 
     481  (princ #\: (stream *json-output*)) 
     482  (json:encode-json value (stream *json-output*))) 
    471483 
    472484(defmethod handle-object ((handler news-json-handler) (channel rss-channel)) 
    …… 
    476488        (dolist (item (rss-channel-items channel)) 
    477489          (with-json-object () 
    478             (encode-object-member "pubDate" (format-date-time (rss-item-pub-date item) :vms-style t)) 
    479             (encode-object-member "title" (rss-item-title item)) 
    480             (encode-object-member "description" (rss-item-description item)))))))) 
     490            (encode-object-element "pubDate" (format-date-time (rss-item-pub-date item) :vms-style t)) 
     491            (encode-object-element "title" (rss-item-title item)) 
     492            (encode-object-element "description" (rss-item-description item))))))))