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

Add JSON encoding for POIs

U trunk/projects/bos/m2/bos.m2.asd U trunk/projects/bos/m2/poi.lisp U trunk/projects/bos/web/poi-handlers.lisp

Modified: trunk/projects/bos/m2/bos.m2.asd =================================================================== --- trunk/projects/bos/m2/bos.m2.asd 2008-11-27 09:36:39 UTC (rev 4084) +++ trunk/projects/bos/m2/bos.m2.asd 2008-11-27 09:37:31 UTC (rev 4085) @@ -5,7 +5,8 @@ (asdf:defsystem :bos.m2 :depends-on (:bknr.datastore :bknr.modules :cl-smtp :cl-mime :kmrcl :iterate :arnesi - :cl-pdf :cl-pdf-parser :screamer :cl-fad) + :cl-pdf :cl-pdf-parser :screamer :cl-fad + :yason) :components ((:file "packages") (:file "geo-utm" :depends-on ("packages")) (:file "geometry" :depends-on ("packages"))

Modified: trunk/projects/bos/m2/poi.lisp =================================================================== --- trunk/projects/bos/m2/poi.lisp 2008-11-27 09:36:39 UTC (rev 4084) +++ trunk/projects/bos/m2/poi.lisp 2008-11-27 09:37:31 UTC (rev 4085) @@ -84,7 +84,9 @@ ;;; poi-movie (defpersistent-class poi-movie (poi-medium) ((url :accessor poi-movie-url :initarg :url :initform nil) - (created :initform (get-universal-time) :reader poi-medium-creation-time))) + (created :initform (error "need :created initarg when creating poi-medium") + :initarg :created + :reader poi-medium-creation-time)))

;;; poi (defpersistent-class poi (textual-attributes-mixin) @@ -294,3 +296,55 @@ (warn "~s has a url of ~s" movie (poi-movie-url movie)))))) (mapc #'poi-sanity-check (class-instances 'poi)) (values))) + +(defvar *language* "en" + "Current language for JSON encoding") + +(defmethod json:encode ((object symbol) &optional stream) + (json:encode (string-downcase (symbol-name object)) stream)) + +(defgeneric json-encode (object) + (:method-combination progn)) + +(defmethod json-encode progn ((object store-object)) + (json:encode-object-element "id" (store-object-id object))) + +(defmethod json-encode progn ((blob blob)) + (json:encode-object-elements + "type" (blob-type blob) + "timestamp" (format-date-time (blob-timestamp blob) :mail-style t))) + +(defmethod json-encode progn ((image store-image)) + (json:encode-object-elements + "name" (store-image-name image) + "width" (store-image-width image) + "height" (store-image-height image))) + +(defmethod json-encode progn ((object bos.m2::textual-attributes-mixin)) + (dolist (field '(title subtitle description)) + (let ((string (slot-string object field *language*))) + (unless (equal "" string) + (json:encode-object-element field string))))) + +(defmethod json-encode progn ((medium poi-medium)) + (json:encode-object-element + "mediumType" + (cl-ppcre:regex-replace "^poi-" (string-downcase (class-name (class-of medium))) ""))) + +(defmethod json-encode progn ((movie poi-movie)) + (json:encode-object-elements + "url" (poi-movie-url movie) + "timestamp" (format-date-time (poi-medium-creation-time movie) :mail-style t))) + +(defun pois-as-json (language) + (let ((*language* language)) + (json:with-array () + (dolist (poi (class-instances 'poi)) + (when (poi-complete poi language) + (json:with-object () + (json-encode poi) + (json:with-object-element ("media") + (json:with-array () + (dolist (medium (poi-media poi)) + (json:with-object () + (json-encode medium)))))))))))

Modified: trunk/projects/bos/web/poi-handlers.lisp =================================================================== --- trunk/projects/bos/web/poi-handlers.lisp 2008-11-27 09:36:39 UTC (rev 4084) +++ trunk/projects/bos/web/poi-handlers.lisp 2008-11-27 09:37:31 UTC (rev 4085) @@ -346,7 +346,7 @@ (flet ((make-new-medium (new-medium-type poi) (case new-medium-type (poi-movie - (make-instance 'poi-movie :poi poi :url (query-param "url"))) + (make-instance 'poi-movie :poi poi :url (query-param "url") :created (get-universal-time))) (otherwise (let ((upload (request-uploaded-file "image-file"))) (unless upload @@ -683,3 +683,4 @@ (store-object-id (nth image-index (poi-sat-images poi))) imageproc-arguments)) (error "image index ~a out of bounds for poi ~a" image-index poi))))) +