(in-package 'closette :use '(lisp)) (load "newcl.lisp") (load "closette.lisp") (load "extension1.lisp") (load "nmcon3.lisp") (load "message-processing.lisp") ;************[Component definition for WS-Client]********** (defcomponent WS-Client () () (:ports WCRecv WCSend) ) (defgeneric sendREQ ((wc WS-Client) &rest reg) (:method-class component-method) ) (defgeneric recvRep ((wc WS-Client) &rest reg) (:method-class component-method)) ;______________________________________________ (defcomponent-method sendReq WCSend ((wc WS-Client) &rest arg) (print "Sending REQ: ") (print (prepare-request-message arg) ) (drop wc 'WCSend (prepare-request-message arg) ) ) ;______________________________________________ (defcomponent-method recvRep WCRecv ((wc WS-Client) &rest arg) (print "Reply is : ") (print (car arg)) ) ;************[Component definition for WS-Server]********** (defcomponent WS-server () () (:ports WSSend WSRecv) ) (defgeneric recvREQ ( (ws WS-server) &rest reg) (:method-class component-method)) (defgeneric sendRep ( (ws WS-server) &rest reg) (:method-class component-method)) ;_______________________________________________ (defcomponent-method recvREQ WSRecv ( (ws WS-server) &rest arg) (print "REQ Receieved") (print (car arg) ) (drop ws 'wsSend (prepare-reply-message (extract-header-from-request (car arg) ) `(,(extract-body (car arg) ) ':document delivered)) ) ) ;******************[Connector Definition]***************** (defconnector Cache-Con () ( (cache-seq-result :initform (make-hash-table :test #'equal) :accessor cache) ) (:roles wcRecv wcRecv wsSend wsRecv) ) (defgeneric attachments (( con1 Cache-Con) &key wcRecv wcRecv wsSend wsRecv)) (defgeneric create-SOAP-REQ ( (con1 Cache-Con ) &rest arg) (:method-class component-method)) (defgeneric create-SOAP-REP ( (con1 Cache-Con) &rest arg) (:method-class component-method)) (defgeneric push-seqno-on-pending-req ((con1 Cache-Con) seqno)) (defgeneric prepare-SOAP-rep ((con1 Cache-Con) seqno)) ;__________________________________________________ (defmethod attachments (( con1 Cache-Con) &key wcRecv wsSend wsRecv wcSend) ;Attaches recv roles with given components (mapcar #'(lambda (a) (eval `(make-connection ,(car a) ',(cadr a) con1 'wcRecv)) ) wcRecv ) ;Attaches broad role with given component (mapcar #'(lambda (a) (eval `(make-connection con1 'wsSend ,(car a) ',(cadr a) )) ) wsSend ) (mapcar #'(lambda (a) (eval `(make-connection ,(car a) ',(cadr a) con1 'wsRecv)) ) wsRecv ) ;Attaches broad role with given component (mapcar #'(lambda (a) (eval `(make-connection con1 'wcSend ,(car a) ',(cadr a) )) ) wcSend ) ) ;********************************************************** (defmethod push-seqno-on-pending-req ((con1 Cache-Con) seqno) (setf (pending-req con1) (push seqno (pending-req con1))) ;(print (pending-req con1)) ) ;__________________________________________________________________ (defconnector-method create-SOAP-REQ wcRecv ( (con1 Cache-Con) &rest arg) (print "In Connector:") (print (car arg)) (let ( (seqno (extract-header-from-request (car arg))) ) (if (gethash seqno (cache con1)) (drop con1 'wcSend (prepare-reply-message seqno (gethash seqno (cache con1)) ) ) (drop con1 'wsSend (car arg) ) ) ) ) ;___________________________________________________________________ (defconnector-method create-SOAP-REP wsRecv ( (con1 Cache-Con) &rest arg) (print "In Connector:") (print (car arg)) (let ( (seqno (extract-header-from-reply (car arg))) (result (extract-body (car arg))) ) (setf (gethash seqno (cache con1)) result) (drop con1 'wcSend (prepare-reply-message seqno result ) ) ) ) (defsystem SOAP-REQ-REP (:component comp1 WS-Client) (:component comp2 WS-Server) (:connector con1 Cache-Con) (:attachments con1 :wcRecv '((comp1 wcSend)) :wsSend '((comp2 wsRecv)) :wsRecv '((comp2 wsSend)) :wcSend '((comp1 wcRecv)) ) ) (print "First Call:") (sendREQ comp1 "earch.pdf") (print (gethash 1947 (cache con1)) ) (print "******************************************") (print "Second Call:") (sendREQ comp1 "earch.pdf")