[bknr-cvs] hans changed trunk/bknr/datastore/src/

[BKNR Commits]

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

Add JSON serialization method for store objects from scrabble project.

U   trunk/bknr/datastore/src/bknr.datastore.asd
A   trunk/bknr/datastore/src/data/json.lisp
U   trunk/bknr/datastore/src/data/package.lisp

Modified: trunk/bknr/datastore/src/bknr.datastore.asd
===================================================================
--- trunk/bknr/datastore/src/bknr.datastore.asd	2008-07-29 22:25:41 UTC (rev 3683)
+++ trunk/bknr/datastore/src/bknr.datastore.asd	2008-07-30 06:29:44 UTC (rev 3684)
@@ -22,12 +22,14 @@
                :unit-test
                :bknr.utils
                :bknr.indices
-               :trivial-utf-8)
+               :trivial-utf-8
+               :cl-json)
 
   :components ((:module "data" :components ((:file "package")
                                             (:file "encoding" :depends-on ("package"))
                                             (:file "txn" :depends-on ("encoding" "package"))
                                             (:file "object" :depends-on ("txn" "package"))
+                                            (:file "json" :depends-on ("object"))
                                             (:file "blob" :depends-on ("txn" "object" "package"))))))
 
 (defsystem :bknr.datastore.test  

Added: trunk/bknr/datastore/src/data/json.lisp
===================================================================
--- trunk/bknr/datastore/src/data/json.lisp	                        (rev 0)
+++ trunk/bknr/datastore/src/data/json.lisp	2008-07-30 06:29:44 UTC (rev 3684)
@@ -0,0 +1,22 @@
+(in-package :bknr.datastore)
+
+(defparameter *ignore-slots* '(bknr.datastore::id bknr.indices::destroyed-p))
+
+(defmacro with-json-ignore-slots ((&rest slots) &body body)
+  `(let ((*ignore-slots* (append *ignore-slots* ,slots)))
+     , at body))
+
+(defmethod json:encode-json ((object store-object) stream)
+  (let (printed)
+    (princ #\{ stream)
+    (dolist (slotdef (closer-mop:class-slots (class-of object)))
+      (when (and (slot-boundp object (closer-mop:slot-definition-name slotdef))
+                 (not (find (closer-mop:slot-definition-name slotdef) *ignore-slots*)))
+        (if printed
+            (princ #\, stream)
+            (setf printed t))
+        (json:encode-json (closer-mop:slot-definition-name slotdef) stream)
+        (princ #\: stream)
+        (json:encode-json (slot-value object (closer-mop:slot-definition-name slotdef)) stream)))
+    (princ #\} stream)))
+

Modified: trunk/bknr/datastore/src/data/package.lisp
===================================================================
--- trunk/bknr/datastore/src/data/package.lisp	2008-07-29 22:25:41 UTC (rev 3683)
+++ trunk/bknr/datastore/src/data/package.lisp	2008-07-30 06:29:44 UTC (rev 3684)
@@ -116,6 +116,9 @@
            #:initialize-subsystem
            #:snapshot-subsystem
            #:restore-subsystem
-           #:ensure-store-current-directory))
+           #:ensure-store-current-directory
 
+           ;; JSON serialization
+           #:with-json-ignore-slots))
 
+