[bknr-cvs] hans changed trunk/projects/bos/

[BKNR Commits]

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