- cl-prevalence-cvs@common-lisp.net - mailman3.common-lisp.net

[cl-prevalence-cvs] CVS update: cl-prevalence/src/master-slave.lisp cl-prevalence/src/prevalence.lisp cl-prevalence/src/sysdeps.lisp
by scaekenberghe＠common-lisp.net 09 Jan '06

09 Jan '06

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv20683/src Modified Files: master-slave.lisp prevalence.lisp Removed Files: sysdeps.lisp Log Message: now using S-SYSDEPS Date: Mon Jan 9 20:21:45 2006 Author: scaekenberghe Index: cl-prevalence/src/master-slave.lisp diff -u cl-prevalence/src/master-slave.lisp:1.1 cl-prevalence/src/master-slave.lisp:1.2 --- cl-prevalence/src/master-slave.lisp:1.1 Mon Jun 28 13:57:30 2004 +++ cl-prevalence/src/master-slave.lisp Mon Jan 9 20:21:44 2006 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: master-slave.lisp,v 1.1 2004/06/28 11:57:30 scaekenberghe Exp $ +;;;; $Id: master-slave.lisp,v 1.2 2006/01/09 19:21:44 scaekenberghe Exp $ ;;;; ;;;; The master-slave system keeps one prevalence system in sync with another ;;;; by sending transactions over a socket @@ -16,7 +16,7 @@ (defun start-master-client (prevalence-system &key (host "localhost") (port 7651)) "Start a connection to host:port to deliver transactions from prevalence-system" (stop-master-client prevalence-system) - (let ((out (open-socket-stream host port))) + (let ((out (s-sysdeps:open-socket-stream host port))) (setf (get-transaction-hook prevalence-system) #'(lambda (transaction) (funcall (get-serializer prevalence-system) @@ -38,7 +38,7 @@ (defun start-slave-server (prevalence-system &key (port 7651)) "Start a server on port accepting transactions to be executed on prevalence-system" - (start-standard-server + (s-sysdeps:start-standard-server :port port :name "prevalence-slave-server" :connection-handler #'(lambda (stream) @@ -50,9 +50,5 @@ (eq transaction :stop)) (return) (execute prevalence-system transaction))))))) - -(defun stop-slave-server (name) - "Stop a slave server by name" - (stop-server name)) ;;;; eof Index: cl-prevalence/src/prevalence.lisp diff -u cl-prevalence/src/prevalence.lisp:1.7 cl-prevalence/src/prevalence.lisp:1.8 --- cl-prevalence/src/prevalence.lisp:1.7 Mon Oct 4 16:25:13 2004 +++ cl-prevalence/src/prevalence.lisp Mon Jan 9 20:21:44 2006 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: prevalence.lisp,v 1.7 2004/10/04 14:25:13 scaekenberghe Exp $ +;;;; $Id: prevalence.lisp,v 1.8 2006/01/09 19:21:44 scaekenberghe Exp $ ;;;; ;;;; Object Prevalence in Common Lisp ;;;; @@ -169,7 +169,7 @@ "Totally destroy system from permanent storage by deleting any files used by the system, remove all root objects" (close-open-streams system :abort abort) (when (probe-file (get-directory system)) - (dolist (pathname (directory (merge-pathnames (make-pathname :type (get-file-extension system)) + (dolist (pathname (directory (merge-pathnames (make-pathname :name :wild :type (get-file-extension system)) (get-directory system)))) (delete-file pathname))) (clrhash (get-root-objects system)))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/cl-prevalence.asd
by scaekenberghe＠common-lisp.net 09 Jan '06

09 Jan '06

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv20683 Modified Files: cl-prevalence.asd Log Message: now using S-SYSDEPS Date: Mon Jan 9 20:21:43 2006 Author: scaekenberghe Index: cl-prevalence/cl-prevalence.asd diff -u cl-prevalence/cl-prevalence.asd:1.3 cl-prevalence/cl-prevalence.asd:1.4 --- cl-prevalence/cl-prevalence.asd:1.3 Thu Jan 5 15:08:22 2006 +++ cl-prevalence/cl-prevalence.asd Mon Jan 9 20:21:43 2006 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: cl-prevalence.asd,v 1.3 2006/01/05 14:08:22 scaekenberghe Exp $ +;;;; $Id: cl-prevalence.asd,v 1.4 2006/01/09 19:21:43 scaekenberghe Exp $ ;;;; ;;;; The CL-PREVALENCE ASDF system definition ;;;; @@ -29,9 +29,8 @@ (:file "serialization" :depends-on ("package")) (:file "prevalence" :depends-on ("serialization")) (:file "managed-prevalence" :depends-on ("prevalence")) - (:file "sysdeps" :depends-on ("package")) - (:file "master-slave" :depends-on ("prevalence" "sysdeps")) + (:file "master-slave" :depends-on ("prevalence")) (:file "blob" :depends-on ("managed-prevalence"))))) - :depends-on (:s-xml)) + :depends-on (:s-xml :s-sysdeps)) ;;;; eof

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/managed-prevalence.lisp
by scaekenberghe＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv27807/src Modified Files: managed-prevalence.lisp Log Message: changed signature Date: Thu Jan 5 15:08:52 2006 Author: scaekenberghe Index: cl-prevalence/src/managed-prevalence.lisp diff -u cl-prevalence/src/managed-prevalence.lisp:1.4 cl-prevalence/src/managed-prevalence.lisp:1.5 --- cl-prevalence/src/managed-prevalence.lisp:1.4 Mon Feb 14 21:20:02 2005 +++ cl-prevalence/src/managed-prevalence.lisp Thu Jan 5 15:08:50 2006 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: managed-prevalence.lisp,v 1.4 2005/02/14 20:20:02 scaekenberghe Exp $ +;;;; $Id: managed-prevalence.lisp,v 1.5 2006/01/05 14:08:50 scaekenberghe Exp $ ;;;; ;;;; The code in this file adds another layer above plain object prevalence. ;;;; We manage objects with ids in an organized fashion, adding an id counter and preferences. @@ -58,7 +58,7 @@ (when index (gethash id index)))) -(defgeneric find-object-with-slot (system class slot value &optional (test #'equalp)) +(defgeneric find-object-with-slot (system class slot value &optional test) (:documentation "Find and return the object in system of class with slot equal to value, null if not found")) (defmethod find-object-with-slot ((system prevalence-system) class slot value &optional (test #'equalp))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/debug-prevalence.lisp
by scaekenberghe＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv27775/src Modified Files: debug-prevalence.lisp Log Message: s-xml::echo-xml is now optional; made debug-prevalence optional as well, noted dependency in a comment Date: Thu Jan 5 15:08:24 2006 Author: scaekenberghe Index: cl-prevalence/src/debug-prevalence.lisp diff -u cl-prevalence/src/debug-prevalence.lisp:1.2 cl-prevalence/src/debug-prevalence.lisp:1.3 --- cl-prevalence/src/debug-prevalence.lisp:1.2 Mon Jul 5 23:22:08 2004 +++ cl-prevalence/src/debug-prevalence.lisp Thu Jan 5 15:08:24 2006 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: debug-prevalence.lisp,v 1.2 2004/07/05 21:22:08 scaekenberghe Exp $ +;;;; $Id: debug-prevalence.lisp,v 1.3 2006/01/05 14:08:24 scaekenberghe Exp $ ;;;; ;;;; Some debugging routines for CL-PREVALENCE ;;;; @@ -12,11 +12,13 @@ (in-package :cl-prevalence) +;; the code for #'s-xml::echo-xml is in "echo.lisp" in S-XML's test code + (defun print-transaction-log (system) "Echo the XML making up the transaction log of system to t" (with-open-file (in (get-transaction-log system) :direction :input) (loop - (let ((transaction (s-xml:echo-xml in *standard-output*))) + (let ((transaction (s-xml::echo-xml in *standard-output*))) (when (null transaction) (return))))) t) @@ -33,7 +35,7 @@ (defun print-snapshot (system) "Echo the XML making up the snapshot of system to t" (with-open-file (in (get-snapshot system) :direction :input) - (s-xml:echo-xml in *standard-output*)) + (s-xml::echo-xml in *standard-output*)) t) (defun transaction-log-tail (system &optional (count 8))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/cl-prevalence.asd
by scaekenberghe＠common-lisp.net 05 Jan '06

05 Jan '06

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv27775 Modified Files: cl-prevalence.asd Log Message: s-xml::echo-xml is now optional; made debug-prevalence optional as well, noted dependency in a comment Date: Thu Jan 5 15:08:23 2006 Author: scaekenberghe Index: cl-prevalence/cl-prevalence.asd diff -u cl-prevalence/cl-prevalence.asd:1.2 cl-prevalence/cl-prevalence.asd:1.3 --- cl-prevalence/cl-prevalence.asd:1.2 Mon Jun 28 13:57:26 2004 +++ cl-prevalence/cl-prevalence.asd Thu Jan 5 15:08:22 2006 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: cl-prevalence.asd,v 1.2 2004/06/28 11:57:26 scaekenberghe Exp $ +;;;; $Id: cl-prevalence.asd,v 1.3 2006/01/05 14:08:22 scaekenberghe Exp $ ;;;; ;;;; The CL-PREVALENCE ASDF system definition ;;;; @@ -28,7 +28,6 @@ ((:file "package") (:file "serialization" :depends-on ("package")) (:file "prevalence" :depends-on ("serialization")) - (:file "debug-prevalence" :depends-on ("prevalence")) (:file "managed-prevalence" :depends-on ("prevalence")) (:file "sysdeps" :depends-on ("package")) (:file "master-slave" :depends-on ("prevalence" "sysdeps"))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/managed-prevalence.lisp
by scaekenberghe＠common-lisp.net 14 Feb '05

14 Feb '05

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv27436/src Modified Files: managed-prevalence.lisp Log Message: some error messages were wrong (format args mixup) Date: Mon Feb 14 21:20:04 2005 Author: scaekenberghe Index: cl-prevalence/src/managed-prevalence.lisp diff -u cl-prevalence/src/managed-prevalence.lisp:1.3 cl-prevalence/src/managed-prevalence.lisp:1.4 --- cl-prevalence/src/managed-prevalence.lisp:1.3 Tue Oct 5 13:44:36 2004 +++ cl-prevalence/src/managed-prevalence.lisp Mon Feb 14 21:20:02 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: managed-prevalence.lisp,v 1.3 2004/10/05 11:44:36 scaekenberghe Exp $ +;;;; $Id: managed-prevalence.lisp,v 1.4 2005/02/14 20:20:02 scaekenberghe Exp $ ;;;; ;;;; The code in this file adds another layer above plain object prevalence. ;;;; We manage objects with ids in an organized fashion, adding an id counter and preferences. @@ -134,12 +134,12 @@ (index-name (get-objects-slot-index-name class 'id))) (setf (get-root-object system root-name) (delete object (get-root-object system root-name))) (remhash id (get-root-object system index-name))) - (error "no object of class ~a with id ~d found in ~s" system class id)))) + (error "no object of class ~a with id ~d found in ~s" class id system)))) (defun tx-change-object-slots (system class id slots-and-values) "Change some slots of the object of class with id in system using slots and values" (let ((object (find-object-with-id system class id))) - (unless object (error "no object of class ~a with id ~d found in ~s" system class id)) + (unless object (error "no object of class ~a with id ~d found in ~s" class id system)) (loop :for (slot value) :in slots-and-values :do (when (slot-value-changed-p object slot value) (remove-object-from-slot-index system class slot object)

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/test-serialization.lisp
by scaekenberghe＠common-lisp.net 24 Jan '05

24 Jan '05

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv28019/test Modified Files: test-serialization.lisp Log Message: added support for unprintable symbols in serialization Date: Mon Jan 24 02:04:20 2005 Author: scaekenberghe Index: cl-prevalence/test/test-serialization.lisp diff -u cl-prevalence/test/test-serialization.lisp:1.3 cl-prevalence/test/test-serialization.lisp:1.4 --- cl-prevalence/test/test-serialization.lisp:1.3 Sat Jan 22 11:24:00 2005 +++ cl-prevalence/test/test-serialization.lisp Mon Jan 24 02:04:18 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: test-serialization.lisp,v 1.3 2005/01/22 19:24:00 scaekenberghe Exp $ +;;;; $Id: test-serialization.lisp,v 1.4 2005/01/24 10:04:18 scaekenberghe Exp $ ;;;; ;;;; Testing XML and S-Expression based Serialization for Common Lisp and CLOS ;;;; @@ -95,6 +95,14 @@ (assert (eq (serialize-and-deserialize-sexp 'room) 'room)) + +(assert + (eq (serialize-and-deserialize-xml '|Unprintable|) + '|Unprintable|)) + +(assert + (eq (serialize-and-deserialize-sexp '|Unprintable|) + '|Unprintable|)) (assert (equal (serialize-and-deserialize-xml "Hello")

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/serialization.lisp
by scaekenberghe＠common-lisp.net 24 Jan '05

24 Jan '05

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv28019/src Modified Files: serialization.lisp Log Message: added support for unprintable symbols in serialization Date: Mon Jan 24 02:04:16 2005 Author: scaekenberghe Index: cl-prevalence/src/serialization.lisp diff -u cl-prevalence/src/serialization.lisp:1.8 cl-prevalence/src/serialization.lisp:1.9 --- cl-prevalence/src/serialization.lisp:1.8 Sat Jan 22 11:23:54 2005 +++ cl-prevalence/src/serialization.lisp Mon Jan 24 02:04:15 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: serialization.lisp,v 1.8 2005/01/22 19:23:54 scaekenberghe Exp $ +;;;; $Id: serialization.lisp,v 1.9 2005/01/24 10:04:15 scaekenberghe Exp $ ;;;; ;;;; XML and S-Expression based Serialization for Common Lisp and CLOS ;;;; @@ -91,28 +91,36 @@ (setf (gethash object (get-hashtable serialization-state)) (incf (get-counter serialization-state)))) +;; when printing symbols we always add the package and treat the symbol as internal +;; so that the serialization is independent of future change in export status +;; we handling symbols in the common-lisp and keyword package more efficiently +;; some hacking to handle unprintable symbols is involved + (defconstant +cl-package+ (find-package :cl)) (defconstant +keyword-package+ (find-package :keyword)) (defun print-symbol-xml (symbol stream) (let ((package (symbol-package symbol)) - (name (symbol-name symbol))) + (name (prin1-to-string symbol))) (cond ((eq package +cl-package+) (write-string "CL:" stream)) ((eq package +keyword-package+) (write-char #\: stream)) (t (s-xml:print-string-xml (package-name package) stream) (write-string "::" stream))) - (s-xml:print-string-xml name stream))) + (if (char= (char name (1- (length name))) #\|) + (s-xml:print-string-xml name stream :start (position #\| name)) + (s-xml:print-string-xml name stream :start (1+ (or (position #\: name :from-end t) -1)))))) (defun print-symbol (symbol stream) (let ((package (symbol-package symbol)) - (name (symbol-name symbol))) + (name (prin1-to-string symbol))) (cond ((eq package +cl-package+) (write-string "CL:" stream)) ((eq package +keyword-package+) (write-char #\: stream)) - (t (write-string (package-name package) stream) + (t (s-xml:print-string-xml (package-name package) stream) (write-string "::" stream))) - ;; this is *NOT* correct for unprintable symbols !! - (write-string name stream))) + (if (char= (char name (1- (length name))) #\|) + (write-string name stream :start (position #\| name)) + (write-string name stream :start (1+ (or (position #\: name :from-end t) -1)))))) (defmethod serializable-slots ((object structure-object)) #+openmcl

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/ChangeLog
by scaekenberghe＠common-lisp.net 24 Jan '05

24 Jan '05

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv28019 Modified Files: ChangeLog Log Message: added support for unprintable symbols in serialization Date: Mon Jan 24 02:04:15 2005 Author: scaekenberghe Index: cl-prevalence/ChangeLog diff -u cl-prevalence/ChangeLog:1.1 cl-prevalence/ChangeLog:1.2 --- cl-prevalence/ChangeLog:1.1 Sat Jan 22 11:23:51 2005 +++ cl-prevalence/ChangeLog Mon Jan 24 02:04:14 2005 @@ -1,5 +1,6 @@ 2005-01-22 Sven Van Caekenberghe <svc(a)mac.com> * added serialization support for characters (suggested by ian eslick) + * added support for unprintable symbols

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/test-serialization.lisp
by scaekenberghe＠common-lisp.net 22 Jan '05

22 Jan '05

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv5673/test Modified Files: test-serialization.lisp Log Message: added serialization support for characters (suggested by ian eslick) Date: Sat Jan 22 11:24:00 2005 Author: scaekenberghe Index: cl-prevalence/test/test-serialization.lisp diff -u cl-prevalence/test/test-serialization.lisp:1.2 cl-prevalence/test/test-serialization.lisp:1.3 --- cl-prevalence/test/test-serialization.lisp:1.2 Mon Oct 4 07:52:52 2004 +++ cl-prevalence/test/test-serialization.lisp Sat Jan 22 11:24:00 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: test-serialization.lisp,v 1.2 2004/10/04 14:52:52 scaekenberghe Exp $ +;;;; $Id: test-serialization.lisp,v 1.3 2005/01/22 19:24:00 scaekenberghe Exp $ ;;;; ;;;; Testing XML and S-Expression based Serialization for Common Lisp and CLOS ;;;; @@ -111,6 +111,22 @@ (assert (equal (serialize-and-deserialize-sexp "") "")) + +(assert + (equal (serialize-and-deserialize-xml #\A) + #\A)) + +(assert + (equal (serialize-and-deserialize-sexp #\A) + #\A)) + +(assert + (equal (serialize-and-deserialize-xml #\<) + #\<)) + +(assert + (equal (serialize-and-deserialize-sexp #\<) + #\<)) (assert (equal (serialize-and-deserialize-xml "Hello <foo> & </bar>!")

1 0