[nio-cvs] r37 - branches/home/psmith/restructure/src/protocol/yarpc

[psmith at common-lisp.net]

Author: psmith
Date: Mon Jan 15 01:49:25 2007
New Revision: 37

Modified:
   branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp
   branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp
Log:
yarpc roundtrip complete

Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp
==============================================================================
--- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp	(original)
+++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp	Mon Jan 15 01:49:25 2007
@@ -36,30 +36,48 @@
   (make-instance 'yarpc-packet-factory))     
 
 (defconstant CALL-METHOD-PACKET-ID #x0)
-(defconstant METHOD-RESPONSE-PACKET-ID 1)
+(defconstant METHOD-RESPONSE-PACKET-ID #x1)
 
 (defmethod get-packet ((pf yarpc-packet-factory) buf)
   (flip buf)
-;  (format t "get-packet::read string - ~A~%" (bytebuffer-read-string buf (remaining buf)))
-  (if (>= (remaining buf) 1) ;; First byte denotes packet ID
-    (ecase (elt (bytebuffer-read-vector buf 1) 0)
-      (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (make-instance 'call-method-packet :call (bytebuffer-read-string buf (remaining buf)))))
-      (1 (format t "got METHOD-RESPONSE-PACKET-ID~%")))))
+  (let ((ret (if (> (remaining buf) 0) ;; First byte denotes packet ID
+		 (ecase (elt (bytebuffer-read-vector buf 1) 0)
+		   (0 (progn (format t "got CALL-METHOD-PACKET-ID~%") (call-method-packet (bytebuffer-read-string buf (remaining buf)))))
+		   (1 (progn (format t "got METHOD-RESPONSE-PACKET-ID~%") (method-response-packet (bytebuffer-read-string buf (remaining buf)))))))))
+    (if (> (remaining buf) 0)
+	(error 'not-implemented-yet)
+	(clear buf))
+    ret))
 
-(defclass call-method-packet (packet)((call-string :initarg :call
-                                            :accessor get-call-string)))
+(defclass call-method-packet (packet)((call-string :initarg :call-string
+                                            :accessor call-string)))
+
+(defun call-method-packet (call-string)
+  (make-instance 'call-method-packet :call-string call-string))
 
 (defmethod print-object ((packet call-method-packet) stream)
-  (format stream "#<CALL-METHOD-PACKET ~A >" (get-call-string packet)))
+  (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet)))
 
 (defmethod write-bytes((packet call-method-packet) buf)
   (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf)
 ;  (nio-buffer:flip buf)
   (nio-buffer:bytebuffer-write-vector buf #(#x0))
-  (nio-buffer:bytebuffer-write-string buf (get-call-string packet))
+  (nio-buffer:bytebuffer-write-string buf (call-string packet))
   (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf)  )
   
 
-(defclass method-response-packet (packet)())
+(defclass method-response-packet (packet)
+  ((response :initarg :response
+	     :accessor response)))
+
+(defun method-response-packet (response)
+  (make-instance 'method-response-packet :response response))
 
+(defmethod print-object ((packet method-response-packet) stream)
+  (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet)))
 
+(defmethod write-bytes((packet method-response-packet) buf)
+  (format t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf)
+  (nio-buffer:bytebuffer-write-vector buf #(#x1))
+  (nio-buffer:bytebuffer-write-string buf (write-to-string (response packet)))
+  (format t "yarpc-packet-factory:write-bytes - written ~A~%" buf)  )

Modified: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp
==============================================================================
--- branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp	(original)
+++ branches/home/psmith/restructure/src/protocol/yarpc/yarpc-state-machine.lisp	Mon Jan 15 01:49:25 2007
@@ -98,22 +98,28 @@
     (setf (outgoing-packet sm) nil)
     packet))
 
+;TODO queue and thread stuf
+(defmethod queue-outgoing-packet((sm yarpc-state-machine) packet)
+  (setf (outgoing-packet sm) packet))
 
 ;Process a call method packet, returns 
 (defmethod process-incoming-packet ((sm yarpc-state-machine) (call call-method-packet))
-  ;todo change state, create method-response packet and return it
-  ;(assert (eql state 0))
+  (assert (eql state STATE-INITIALISED))
   (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm call)
   (handler-case
-    (let ((result (execute-call (get-call-string call))))
+    (let ((result (execute-call (call-string call))))
       (when result 
       	(let ((response-packet (progn 
                                   (setf state STATE-SEND-RESPONSE)
-                                  (method-response-packet result))))
-          (values response-packet t))))
-    (reader-error (re) (format t "No such function ~A~%" (get-call-string call)))
-    (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (get-call-string call)))))
-
+                                  (queue-outgoing-packet sm (method-response-packet result)))))
+          t)))
+    (reader-error (re) (format t "No such function ~A~%" (call-string call)))
+    (authorization-error (ae) (format t "Function not declared with defremote ~A~%" (call-string call)))))
+
+(defmethod process-incoming-packet ((sm yarpc-state-machine) (response method-response-packet))
+  (assert (eql state STATE-INITIALISED))
+  (format t "yarpc-state-machine:process-incoming-packet called :sm ~A :packet ~A~%" sm response))
+  
 
 (defun execute-call (call-string)
       (let* ((rpc-call-list (read-from-string call-string ))
@@ -125,5 +131,5 @@
 
 
 (defmethod remote-execute ((sm yarpc-state-machine) call-string)
-  (setf (outgoing-packet sm) (make-instance 'call-method-packet :call call-string)))
+  (queue-outgoing-packet sm (make-instance 'call-method-packet :call-string call-string)))
     
\ No newline at end of file