From: Scott McKay Date: Wed, 13 Jun 2012 22:00:15 +0000 (+0000) Subject: Simplify one interface a tiny bit X-Git-Url: https://asedeno.scripts.mit.edu/gitweb/?a=commitdiff_plain;h=cc19985003f9215208a5e83e7474a86aee95eb59;p=cl-protobufs.git Simplify one interface a tiny bit git-svn-id: http://svn.internal.itasoftware.com/svn/ita/trunk/qres/lisp/libs/cl-protobufs@548951 f8382938-511b-0410-9cdd-bb47b084005c --- diff --git a/examples.lisp b/examples.lisp index 8067bf9..f4809bd 100644 --- a/examples.lisp +++ b/examples.lisp @@ -102,19 +102,17 @@ (eval (proto-impl:generate-serializer message)) (eval (proto-impl:generate-deserializer message)))) -(time (progn (setq gser (proto:serialize-object-to-stream geodata 'geodata :stream nil)) nil)) +(time (progn (setq gser (proto:serialize-object-to-bytes geodata 'geodata)) nil)) (time (proto:deserialize-object 'geodata gser)) -(equalp gser (proto:serialize-object-to-stream - (proto:deserialize-object 'geodata gser) - 'geodata :stream nil)) +(equalp gser (proto:serialize-object-to-bytes + (proto:deserialize-object 'geodata gser) 'geodata)) -(time (progn (setq gser-v (proto:serialize-object-to-stream geodata-v 'geodata-v :stream nil)) nil)) +(time (progn (setq gser-v (proto:serialize-object-to-bytes geodata-v 'geodata-v)) nil)) (time (proto:deserialize-object 'geodata-v gser-v)) -(equalp gser-v (proto:serialize-object-to-stream - (proto:deserialize-object 'geodata-v gser-v) - 'geodata-v :stream nil)) +(equalp gser-v (proto:serialize-object-to-bytes + (proto:deserialize-object 'geodata-v gser-v) 'geodata-v)) (equalp gser gser-v) ||# @@ -153,7 +151,7 @@ (cdr x)) (let ((list '("this" "is" "a" ("nested" "test")))) - (proto:serialize-object-to-stream list 'typed-list :stream nil) + (proto:serialize-object-to-bytes list 'typed-list) (proto:print-text-format list 'typed-list) (proto:print-text-format list 'typed-list :suppress-line-breaks t) (let ((text (with-output-to-string (s) @@ -162,7 +160,7 @@ (proto:parse-text-format 'typed-list :stream s)))) (let ((list '((1 one) (2 two) (3 three)))) - (proto:serialize-object-to-stream list 'typed-list :stream nil) + (proto:serialize-object-to-bytes list 'typed-list) (proto:print-text-format list 'typed-list) (proto:print-text-format list 'typed-list :suppress-line-breaks t) (let ((text (with-output-to-string (s) @@ -217,13 +215,13 @@ (setf (color-opacity color2) 50) (progn (format t "~2&Unextended (has-extension ~S)~%" (has-extension color1 'opacity)) - (let ((ser1 (proto:serialize-object-to-stream rqst1 'add-color-request :stream nil))) + (let ((ser1 (proto:serialize-object-to-bytes rqst1 'add-color-request))) (print ser1) (proto:print-text-format rqst1) (proto:print-text-format (proto:deserialize-object 'add-color-request ser1)))) (progn (format t "~2&Extended (has-extension ~S)~%" (has-extension color2 'opacity)) - (let ((ser2 (proto:serialize-object-to-stream rqst2 'add-color-request :stream nil))) + (let ((ser2 (proto:serialize-object-to-bytes rqst2 'add-color-request))) (print ser2) (proto:print-text-format rqst2) (proto:print-text-format (proto:deserialize-object 'add-color-request ser2))))) @@ -288,13 +286,13 @@ (rqst2 (make-instance 'add-color2 :wheel wheel2 :color color2))) (progn (format t "~2&Nested") - (let ((ser1 (proto:serialize-object-to-stream rqst1 'add-color1 :stream nil))) + (let ((ser1 (proto:serialize-object-to-bytes rqst1 'add-color1))) (print ser1) (proto:print-text-format rqst1) (proto:print-text-format (proto:deserialize-object 'add-color1 ser1)))) (progn (format t "~2&Group") - (let ((ser2 (proto:serialize-object-to-stream rqst2 'add-color2 :stream nil))) + (let ((ser2 (proto:serialize-object-to-bytes rqst2 'add-color2))) (print ser2) (proto:print-text-format rqst2) (proto:print-text-format (proto:deserialize-object 'add-color2 ser2))))) diff --git a/pkgdcl.lisp b/pkgdcl.lisp index 15fd019..d529061 100644 --- a/pkgdcl.lisp +++ b/pkgdcl.lisp @@ -71,9 +71,11 @@ ;; Serialization and deserialization (wire format) "SERIALIZE-OBJECT-TO-FILE" "SERIALIZE-OBJECT-TO-STREAM" + "SERIALIZE-OBJECT-TO-BYTES" "SERIALIZE-OBJECT" "DESERIALIZE-OBJECT-FROM-FILE" "DESERIALIZE-OBJECT-FROM-STREAM" + "DESERIALIZE-OBJECT-FROM-BYTES" "DESERIALIZE-OBJECT" "OBJECT-SIZE" diff --git a/serialize.lisp b/serialize.lisp index 97149f2..bb36ad5 100644 --- a/serialize.lisp +++ b/serialize.lisp @@ -15,9 +15,25 @@ ;;; Serialization -;; Serialize the object using the given protobuf type +(defun serialize-object-to-file (filename object type &key visited) + "Serializes the object 'object' of type 'type' into the file 'filename' + using the wire format. + 'object' and 'type' are the same as for 'serialize-object-to-bytes'." + (with-open-file (stream filename + :direction :output + :element-type '(unsigned-byte 8)) + (serialize-object-to-stream object type :stream stream :visited visited))) + (defun serialize-object-to-stream (object type &key (stream *standard-output*) visited) "Serializes the object 'object' of type 'type' onto the stream 'stream' + using the wire format. + 'object' and 'type' are the same as for 'serialize-object-to-bytes'." + (let ((buffer (serialize-object-to-bytes object type :visited visited))) + (write-sequence buffer stream) + buffer)) + +(defun serialize-object-to-bytes (object type &key visited) + "Serializes the object 'object' of type 'type' into a new byte vector using the wire format. 'type' is the Lisp name of a Protobufs message (usually the name of a Lisp class) or a 'protobuf-message'. @@ -31,15 +47,10 @@ (size (object-size object type visited)) (buffer (make-byte-vector size))) (serialize-object object type buffer 0 visited) - (when stream - (write-sequence buffer stream)) buffer)) -(defun serialize-object-to-file (filename object type &key visited) - (with-open-file (stream filename - :direction :output - :element-type '(unsigned-byte 8)) - (serialize-object-to-stream object type :stream stream :visited visited))) +;; Serialize the object using the given protobuf type + ;; Allow clients to add their own methods ;; This is how we address the problem of cycles, e.g. -- if you have an object @@ -178,21 +189,29 @@ ;;; Deserialization +(defun deserialize-object-from-file (type filename) + "Deserializes an object of the given type 'type' from the given file + as a Protobuf object." + (with-open-file (stream filename + :direction :input + :element-type '(unsigned-byte 8)) + (deserialize-object-from-stream type :stream stream))) + (defun deserialize-object-from-stream (type &key (stream *standard-input*)) - "Deserializes an object of the given type 'type' as a Protobuf object. - 'type' is the Lisp name of a Protobufs message (usually the name of a - Lisp class) or a 'protobuf-message'. - The return value is the object." + "Deserializes an object of the given type 'type' from the given stream + as a Protobuf object." (let* ((size (file-length stream)) (buffer (make-byte-vector size))) (read-sequence buffer stream) (deserialize-object type buffer 0 size))) -(defun deserialize-object-from-file (type filename) - (with-open-file (stream filename - :direction :input - :element-type '(unsigned-byte 8)) - (deserialize-object-from-stream type :stream stream))) +(defun deserialize-object-from-bytes (type buffer) + "Deserializes an object of the given type 'type' from the given stream + as a Protobuf object. + 'type' is the Lisp name of a Protobufs message (usually the name of a + Lisp class) or a 'protobuf-message'. + The return value is the object." + (deserialize-object type buffer)) ;; Allow clients to add their own methods ;; This is you might preserve object identity, e.g. diff --git a/tests/cl-protobufs-tests.asd b/tests/cl-protobufs-tests.asd index f44b608..be4394b 100644 --- a/tests/cl-protobufs-tests.asd +++ b/tests/cl-protobufs-tests.asd @@ -19,7 +19,7 @@ :maintainer '("Scott McKay") :description "Test code for Protobufs for Common Lisp" :long-description "Test code for Protobufs for Common Lisp" - :depends-on (:protobufs :quux :test-tools + :depends-on (:cl-protobufs :quux :test-tools ;; Some of these tests use QRes business data #+qres :qres-core) :serial t diff --git a/tests/serialization-tests.lisp b/tests/serialization-tests.lisp index cce1192..bc98ce0 100644 --- a/tests/serialization-tests.lisp +++ b/tests/serialization-tests.lisp @@ -84,13 +84,13 @@ :color :red :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven"))) (test6 (make-instance 'basic-test6 :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven") :recvals (list test2 test2b)))) - (let ((tser1 (serialize-object-to-stream test1 'basic-test1 :stream nil)) - (tser1b (serialize-object-to-stream test1b 'basic-test1 :stream nil)) - (tser2 (serialize-object-to-stream test2 'basic-test2 :stream nil)) - (tser3 (serialize-object-to-stream test3 'basic-test3 :stream nil)) - (tser4 (serialize-object-to-stream test4 'basic-test4 :stream nil)) - (tser5 (serialize-object-to-stream test5 'basic-test5 :stream nil)) - (tser6 (serialize-object-to-stream test6 'basic-test6 :stream nil))) + (let ((tser1 (serialize-object-to-bytes test1 'basic-test1)) + (tser1b (serialize-object-to-bytes test1b 'basic-test1)) + (tser2 (serialize-object-to-bytes test2 'basic-test2)) + (tser3 (serialize-object-to-bytes test3 'basic-test3)) + (tser4 (serialize-object-to-bytes test4 'basic-test4)) + (tser5 (serialize-object-to-bytes test5 'basic-test5)) + (tser6 (serialize-object-to-bytes test6 'basic-test6))) (qtest:assert-true (equalp tser1 #(#x08 #x96 #x01))) (qtest:assert-true (equalp tser1b #(#x08 #xEA #xFE #xFF #xFF #x0F))) (qtest:assert-true (equalp tser2 #(#x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))) @@ -152,13 +152,13 @@ :color :red :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven"))) (test6 (make-instance 'basic-test6 :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven") :recvals (list test2 test2b)))) - (let ((tser1 (serialize-object-to-stream test1 'basic-test1 :stream nil)) - (tser1b (serialize-object-to-stream test1b 'basic-test1 :stream nil)) - (tser2 (serialize-object-to-stream test2 'basic-test2 :stream nil)) - (tser3 (serialize-object-to-stream test3 'basic-test3 :stream nil)) - (tser4 (serialize-object-to-stream test4 'basic-test4 :stream nil)) - (tser5 (serialize-object-to-stream test5 'basic-test5 :stream nil)) - (tser6 (serialize-object-to-stream test6 'basic-test6 :stream nil))) + (let ((tser1 (serialize-object-to-bytes test1 'basic-test1)) + (tser1b (serialize-object-to-bytes test1b 'basic-test1)) + (tser2 (serialize-object-to-bytes test2 'basic-test2)) + (tser3 (serialize-object-to-bytes test3 'basic-test3)) + (tser4 (serialize-object-to-bytes test4 'basic-test4)) + (tser5 (serialize-object-to-bytes test5 'basic-test5)) + (tser6 (serialize-object-to-bytes test6 'basic-test6))) (qtest:assert-true (equalp tser1 #(#x08 #x96 #x01))) (qtest:assert-true (equalp tser1b #(#x08 #xEA #xFE #xFF #xFF #x0F))) (qtest:assert-true (equalp tser2 #(#x12 #x07 #x74 #x65 #x73 #x74 #x69 #x6E #x67))) @@ -215,13 +215,13 @@ :color :red :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven"))) (test6 (make-instance 'basic-test6 :intvals '(2 3 5 7) :strvals '("two" "three" "five" "seven") :recvals (list test2 test2b)))) - (let ((tser1 (serialize-object-to-stream test1 'basic-test1 :stream nil)) - (tser1b (serialize-object-to-stream test1b 'basic-test1 :stream nil)) - (tser2 (serialize-object-to-stream test2 'basic-test2 :stream nil)) - (tser3 (serialize-object-to-stream test3 'basic-test3 :stream nil)) - (tser4 (serialize-object-to-stream test4 'basic-test4 :stream nil)) - (tser5 (serialize-object-to-stream test5 'basic-test5 :stream nil)) - (tser6 (serialize-object-to-stream test6 'basic-test6 :stream nil))) + (let ((tser1 (serialize-object-to-bytes test1 'basic-test1)) + (tser1b (serialize-object-to-bytes test1b 'basic-test1)) + (tser2 (serialize-object-to-bytes test2 'basic-test2)) + (tser3 (serialize-object-to-bytes test3 'basic-test3)) + (tser4 (serialize-object-to-bytes test4 'basic-test4)) + (tser5 (serialize-object-to-bytes test5 'basic-test5)) + (tser6 (serialize-object-to-bytes test6 'basic-test6))) (macrolet ((slots-equalp (obj1 obj2 &rest slots) (quux:with-gensyms (vobj1 vobj2) (quux:with-collectors ((forms collect-form)) @@ -319,9 +319,9 @@ (qtest:define-test serialization-integrity () (flet ((do-test (message) (let* ((type (type-of message)) - (buf (proto:serialize-object-to-stream message type :stream nil)) + (buf (proto:serialize-object-to-bytes message type)) (new (proto:deserialize-object type buf)) - (newbuf (proto:serialize-object-to-stream new type :stream nil))) + (newbuf (proto:serialize-object-to-bytes new type))) (qtest:assert-true (equalp (length buf) (length newbuf))) (qtest:assert-true (equalp buf newbuf)) (qtest:assert-true (string= (with-output-to-string (s) @@ -368,10 +368,9 @@ :regions regions :cities cities :airports airports))) - (let ((gser (proto:serialize-object-to-stream geodata 'geodata :stream nil))) - (qtest:assert-true (equalp gser (proto:serialize-object-to-stream - (proto:deserialize-object 'geodata gser) - 'geodata :stream nil)))))) + (let ((gser (proto:serialize-object-to-bytes geodata 'geodata))) + (qtest:assert-true (equalp gser (proto:serialize-object-to-bytes + (proto:deserialize-object 'geodata gser) 'geodata)))))) (qtest:define-test geodata-optimized-serialization () (dolist (class '(qres-core::country qres-core::region qres-core::region-key @@ -393,10 +392,9 @@ :regions regions :cities cities :airports airports))) - (let ((gser (proto:serialize-object-to-stream geodata 'geodata :stream nil))) - (qtest:assert-true (equalp gser (proto:serialize-object-to-stream - (proto:deserialize-object 'geodata gser) - 'geodata :stream nil)))))) + (let ((gser (proto:serialize-object-to-bytes geodata 'geodata))) + (qtest:assert-true (equalp gser (proto:serialize-object-to-bytes + (proto:deserialize-object 'geodata gser) 'geodata)))))) ) ;#+qres @@ -442,13 +440,13 @@ (car2 (make-instance 'automobile :model "Audi" :color color2)) (rqst2 (make-instance 'buy-car-request :auto car2))) (setf (auto-color-paint-type color2) :metallic) - (let ((ser1 (proto:serialize-object-to-stream rqst1 'buy-car-request :stream nil))) + (let ((ser1 (proto:serialize-object-to-bytes rqst1 'buy-car-request))) (qtest:assert-true (string= (with-output-to-string (s) (proto:print-text-format rqst1 nil :stream s)) (with-output-to-string (s) (proto:print-text-format (proto:deserialize-object 'buy-car-request ser1) nil :stream s))))) - (let ((ser2 (proto:serialize-object-to-stream rqst2 'buy-car-request :stream nil))) + (let ((ser2 (proto:serialize-object-to-bytes rqst2 'buy-car-request))) (qtest:assert-true (string= (with-output-to-string (s) (proto:print-text-format rqst2 nil :stream s)) (with-output-to-string (s) @@ -523,8 +521,8 @@ (wheel2 (make-instance 'color-wheel2 :name "Colors" :metadata meta2)) (color2 (make-instance 'color2 :r-value 100 :g-value 0 :b-value 100)) (rqst2 (make-instance 'add-color2 :wheel wheel2 :color color2))) - (let ((ser1 (proto:serialize-object-to-stream rqst1 'add-color1 :stream nil)) - (ser2 (proto:serialize-object-to-stream rqst2 'add-color2 :stream nil))) + (let ((ser1 (proto:serialize-object-to-bytes rqst1 'add-color1)) + (ser2 (proto:serialize-object-to-bytes rqst2 'add-color2))) (qtest:assert-true (string= (with-output-to-string (s) (proto:print-text-format rqst1 nil :stream s)) (with-output-to-string (s)