June 2004 - cl-prevalence-cvs@common-lisp.net

[cl-prevalence-cvs] CVS update: cl-prevalence/src/blob.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv12352/src Modified Files: blob.lisp Log Message: minor bugfix Date: Mon Jun 28 05:54:47 2004 Author: scaekenberghe Index: cl-prevalence/src/blob.lisp diff -u cl-prevalence/src/blob.lisp:1.1.1.1 cl-prevalence/src/blob.lisp:1.2 --- cl-prevalence/src/blob.lisp:1.1.1.1 Sun Jun 20 12:13:38 2004 +++ cl-prevalence/src/blob.lisp Mon Jun 28 05:54:47 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: blob.lisp,v 1.1.1.1 2004/06/20 19:13:38 scaekenberghe Exp $ +;;;; $Id: blob.lisp,v 1.2 2004/06/28 12:54:47 scaekenberghe Exp $ ;;;; ;;;; Blobs represent collections of bytes of a certain mime type, ;;;; where the bytes themselves are stored automatically in an ordinary file. @@ -78,7 +78,7 @@ (with-open-file (out (get-file blob) :direction :output :element-type '(unsigned-byte 8) - :if-exists :overwrite + :if-exists :supersede :if-does-not-exist :create) (copy-stream binary-input-stream out)))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/test-master-slave.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv19488/test Added Files: test-master-slave.lisp Log Message: added first proof-of-concept version of master-slave replication between 2 systems Date: Mon Jun 28 04:57:30 2004 Author: scaekenberghe

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/master-slave.lisp cl-prevalence/src/package.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv19488/src Modified Files: package.lisp Added Files: master-slave.lisp Log Message: added first proof-of-concept version of master-slave replication between 2 systems Date: Mon Jun 28 04:57:30 2004 Author: scaekenberghe Index: cl-prevalence/src/package.lisp diff -u cl-prevalence/src/package.lisp:1.3 cl-prevalence/src/package.lisp:1.4 --- cl-prevalence/src/package.lisp:1.3 Mon Jun 21 08:26:21 2004 +++ cl-prevalence/src/package.lisp Mon Jun 28 04:57:30 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: package.lisp,v 1.3 2004/06/21 15:26:21 scaekenberghe Exp $ +;;;; $Id: package.lisp,v 1.4 2004/06/28 11:57:30 scaekenberghe Exp $ ;;;; ;;;; Package definitions for the CL-PREVALENCE project ;;;; @@ -21,7 +21,7 @@ (defpackage :cl-prevalence (:use :cl :s-serialization) - #+NIL(:nicknames :clp) + #+nil (:nicknames :clp) (:export #:make-prevalence-system #:make-transaction @@ -72,7 +72,12 @@ #:tx-change-object-slots #:get-preference #:all-preferences-keys - #:tx-set-preference) + #:tx-set-preference + + #:start-master-client + #:stop-master-client + #:start-slave-server + #:stop-slave-server) (:documentation "An implementation of Object Prevalence for Common Lisp")) ;;;; eof

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/cl-prevalence.asd
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv19488 Modified Files: cl-prevalence.asd Log Message: added first proof-of-concept version of master-slave replication between 2 systems Date: Mon Jun 28 04:57:26 2004 Author: scaekenberghe Index: cl-prevalence/cl-prevalence.asd diff -u cl-prevalence/cl-prevalence.asd:1.1.1.1 cl-prevalence/cl-prevalence.asd:1.2 --- cl-prevalence/cl-prevalence.asd:1.1.1.1 Sun Jun 20 12:13:38 2004 +++ cl-prevalence/cl-prevalence.asd Mon Jun 28 04:57:26 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: cl-prevalence.asd,v 1.1.1.1 2004/06/20 19:13:38 scaekenberghe Exp $ +;;;; $Id: cl-prevalence.asd,v 1.2 2004/06/28 11:57:26 scaekenberghe Exp $ ;;;; ;;;; The CL-PREVALENCE ASDF system definition ;;;; @@ -30,6 +30,8 @@ (: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")) (:file "blob" :depends-on ("managed-prevalence"))))) :depends-on (:s-xml))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/prevalence.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv17101/src Modified Files: prevalence.lisp Log Message: introduced transaction-hook turned *serialization-state* into an instance variable in prevalence-system bugfixes to filenaming methods Date: Mon Jun 28 04:56:35 2004 Author: scaekenberghe Index: cl-prevalence/src/prevalence.lisp diff -u cl-prevalence/src/prevalence.lisp:1.4 cl-prevalence/src/prevalence.lisp:1.5 --- cl-prevalence/src/prevalence.lisp:1.4 Sun Jun 27 09:37:10 2004 +++ cl-prevalence/src/prevalence.lisp Mon Jun 28 04:56:35 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: prevalence.lisp,v 1.4 2004/06/27 16:37:10 scaekenberghe Exp $ +;;;; $Id: prevalence.lisp,v 1.5 2004/06/28 11:56:35 scaekenberghe Exp $ ;;;; ;;;; Object Prevalence in Common Lisp ;;;; @@ -96,7 +96,14 @@ (file-extension ;; type string :accessor get-file-extension :initarg :file-extension - :initform "xml")) + :initform "xml") + (serialization-state ;; type serialization-state + :reader get-serialization-state + :initform (make-serialization-state)) + (transaction-hook ;; type function + :accessor get-transaction-hook + :initarg :transaction-hook + :initform #'identity)) (:documentation "Base Prevalence system implementation object")) (defclass guarded-prevalence-system (prevalence-system) @@ -190,8 +197,6 @@ (defmethod remove-root-object ((system prevalence-system) name) (remhash name (get-root-objects system))) -(defparameter *serialization-state* (make-serialization-state)) - (defmethod execute ((system prevalence-system) (transaction transaction)) "Execute a transaction on a system and log it to the transaction log" (let ((result @@ -202,13 +207,21 @@ ";; Notice: system rollback/restore due to error (~a)~%" condition) (restore system))))) - (execute-on transaction system))) - (out (get-transaction-log-stream system))) - (funcall (get-serializer system) transaction out *serialization-state*) - (terpri out) - (finish-output out) + (execute-on transaction system)))) + (log-transaction system transaction) result)) +(defmethod log-transaction ((system prevalence-system) (transaction transaction)) + "Log transaction for system" + (let ((out (get-transaction-log-stream system))) + (funcall (get-serializer system) transaction out (get-serialization-state system)) + (terpri out) + (finish-output out))) + +(defmethod log-transaction :after ((system prevalence-system) (transaction transaction)) + "Execute the transaction-hook" + (funcall (get-transaction-hook system) transaction)) + (defmethod query ((system prevalence-system) function &rest args) "Execute an exclusive query function on a sytem" (apply function (cons system args))) @@ -230,7 +243,7 @@ snapshot))) (with-open-file (out snapshot :direction :output :if-does-not-exist :create :if-exists :supersede) - (funcall (get-serializer system) (get-root-objects system) out *serialization-state*)) + (funcall (get-serializer system) (get-root-objects system) out (get-serialization-state system))) (when (probe-file transaction-log) (copy-file transaction-log (merge-pathnames (make-pathname :name (get-transaction-log-filename timetag) :type (get-file-extension system)) @@ -261,7 +274,7 @@ (close-open-streams system) (when (probe-file (get-snapshot system)) (with-open-file (in (get-snapshot system) :direction :input) - (setf (get-root-objects system) (funcall (get-deserializer system) in *serialization-state*)))) + (setf (get-root-objects system) (funcall (get-deserializer system) in (get-serialization-state system))))) (when (probe-file (get-transaction-log system)) (let ((position 0)) (handler-bind ((s-xml:xml-parser-error @@ -273,7 +286,7 @@ (return-from restore)))) (with-open-file (in (get-transaction-log system) :direction :input) (loop - (let ((transaction (funcall (get-deserializer system) in *serialization-state*))) + (let ((transaction (funcall (get-deserializer system) in (get-serialization-state system)))) (setf position (file-position in)) (if transaction (execute-on transaction system) @@ -316,11 +329,11 @@ (defmethod get-transaction-log-filename ((system prevalence-system) &optional suffix) "Return the name of the transaction-log filename, optionally using a suffix" - (format nil "transaction-log@[-~a]" suffix)) + (format nil "transaction-log~@[-~a~]" suffix)) (defmethod get-snapshot-filename ((system prevalence-system) &optional suffix) "Return the name of the snapshot filename, optionally using a suffix" - (format nil "snapshot@[-~a]" suffix)) + (format nil "snapshot~@[-~a~]" suffix)) ;;; Some file manipulation utilities

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/sysdeps.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv11775/src Added Files: sysdeps.lisp Log Message: introduced sysdeps file Date: Mon Jun 28 04:54:50 2004 Author: scaekenberghe

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/demo2.lisp
by Sven Van Caekenberghe 28 Jun '04

28 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv11775/test Modified Files: demo2.lisp Log Message: introduced sysdeps file Date: Mon Jun 28 04:54:49 2004 Author: scaekenberghe Index: cl-prevalence/test/demo2.lisp diff -u cl-prevalence/test/demo2.lisp:1.1.1.1 cl-prevalence/test/demo2.lisp:1.2 --- cl-prevalence/test/demo2.lisp:1.1.1.1 Sun Jun 20 12:13:42 2004 +++ cl-prevalence/test/demo2.lisp Mon Jun 28 04:54:49 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: demo2.lisp,v 1.1.1.1 2004/06/20 19:13:42 scaekenberghe Exp $ +;;;; $Id: demo2.lisp,v 1.2 2004/06/28 11:54:49 scaekenberghe Exp $ ;;;; ;;;; A Common Lisp version of the the Java Prevalyer demo2 example ;;;; @@ -298,25 +298,16 @@ (delete-account account-number) (setf (get-option *bank-system* :rollback-on-error) nil))) -;;; a multi-processing example (openmcl & lispworks only) +;;; a multi-processing example (defparameter *bank-system-lock* - #+openmcl (ccl:make-lock "bank-system-lock") - #+lispworks (mp:make-lock :name "bank-system-lock") - #+allegro (mp:make-process-lock :name "bank-system-lock") - #-(or openmcl lispworks allegro) nil) + (make-process-lock "bank-system-lock")) (defun bank-system-guard (thunk) - #+openmcl (ccl:with-lock-grabbed (*bank-system-lock*) (funcall thunk)) - #+lispworks (mp:with-lock (*bank-system-lock*) (funcall thunk)) - #+allegro (mp:with-process-lock (*bank-system-lock*) (funcall thunk)) - #-(or openmcl lispworks allegro) (funcall thunk)) + (with-process-lock (*bank-system-lock*) (funcall thunk))) (defun spawn-process (name function) - #+openmcl (ccl:process-run-function name function) - #+lispworks (mp:process-run-function name nil function) - #+allegro (mp:process-run-function name function) - #-(or openmcl lispworks allegro) (funcall function)) + (run-process name function)) (defun bank-test-5-setup () (when *bank-system* (close-open-streams *bank-system*))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/prevalence.lisp
by Sven Van Caekenberghe 27 Jun '04

27 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv10865/src Modified Files: prevalence.lisp Log Message: General code cleanup Added method for snapshot, backup and restore specialized on guarded-prevalence-system that go through the guard thunk Date: Sun Jun 27 09:37:10 2004 Author: scaekenberghe Index: cl-prevalence/src/prevalence.lisp diff -u cl-prevalence/src/prevalence.lisp:1.3 cl-prevalence/src/prevalence.lisp:1.4 --- cl-prevalence/src/prevalence.lisp:1.3 Tue Jun 22 01:37:23 2004 +++ cl-prevalence/src/prevalence.lisp Sun Jun 27 09:37:10 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: prevalence.lisp,v 1.3 2004/06/22 08:37:23 scaekenberghe Exp $ +;;;; $Id: prevalence.lisp,v 1.4 2004/06/27 16:37:10 scaekenberghe Exp $ ;;;; ;;;; Object Prevalence in Common Lisp ;;;; @@ -122,6 +122,12 @@ () (:documentation "Thrown by code inside a transaction to indicate that no rollback is needed")) +(defmethod initiates-rollback ((condition condition)) + t) + +(defmethod initiates-rollback ((no-rollback-error no-rollback-error)) + nil) + ;;; Implementation (defmethod initialize-instance :after ((system prevalence-system) &rest initargs &key &allow-other-keys) @@ -129,9 +135,10 @@ (declare (ignore initargs)) (with-slots (directory) system (ensure-directories-exist directory) - (setf (get-snapshot system) (merge-pathnames (make-pathname :name "snapshot" :type (get-file-extension system)) + (setf (get-snapshot system) (merge-pathnames (make-pathname :name (get-snapshot-filename system) + :type (get-file-extension system)) directory) - (get-transaction-log system) (merge-pathnames (make-pathname :name "transaction-log" + (get-transaction-log system) (merge-pathnames (make-pathname :name (get-transaction-log-filename system) :type (get-file-extension system)) directory))) (restore system)) @@ -145,14 +152,14 @@ :if-exists :append))))) (defmethod close-open-streams ((system prevalence-system) &key abort) - "Close all open stream associated with system" + "Close all open stream associated with system (optionally aborting operations in progress)" (with-slots (transaction-log-stream) system (when transaction-log-stream (close transaction-log-stream :abort abort) (setf transaction-log-stream nil)))) (defmethod totally-destroy ((system prevalence-system) &key abort) - "Totally destroy system from permanent storage by deleting any files that we find" + "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)) @@ -161,9 +168,10 @@ (clrhash (get-root-objects system))) (defmethod print-object ((transaction transaction) stream) - (format stream "#<TRANSACTION ~a ~a>" - (get-function transaction) - (or (get-args transaction) "()"))) + (print-unreadable-object (transaction stream :type t :identity t) + (format stream "~a ~a" + (get-function transaction) + (or (get-args transaction) "()")))) (defmethod get-root-object ((system prevalence-system) name) (gethash name (get-root-objects system))) @@ -190,7 +198,9 @@ (handler-bind ((error #'(lambda (condition) (when (and (get-option system :rollback-on-error) (initiates-rollback condition)) - (format t ";; Notice: system rollback/restore due to error (~a)~%" condition) + (format *standard-output* + ";; Notice: system rollback/restore due to error (~a)~%" + condition) (restore system))))) (execute-on transaction system))) (out (get-transaction-log-stream system))) @@ -203,28 +213,11 @@ "Execute an exclusive query function on a sytem" (apply function (cons system args))) -(defmethod execute ((system guarded-prevalence-system) (transaction transaction)) - "Execute a transaction on a sytem controlled by a guard" - (funcall (get-guard system) - #'(lambda () (call-next-method system transaction)))) - -(defmethod query ((system guarded-prevalence-system) function &rest args) - "Execute an exclusive query function on a sytem controlled by a guard" - (funcall (get-guard system) - #'(lambda () (apply function (cons system args))))) - (defmethod execute-on ((transaction transaction) (system prevalence-system)) "Execute a transaction itself in the context of a system" (apply (get-function transaction) (cons system (get-args transaction)))) -(defun timetag () - (multiple-value-bind (second minute hour date month year) - (decode-universal-time (get-universal-time) 0) - (format nil - "~d~2,'0d~2,'0dT~2,'0d~2,'0d~2,'0d" - year month date hour minute second))) - (defmethod snapshot ((system prevalence-system)) "Write to whole system to persistent storage resetting the transaction log" (let ((timetag (timetag)) @@ -232,14 +225,14 @@ (snapshot (get-snapshot system))) (close-open-streams system) (when (probe-file snapshot) - (copy-file snapshot (merge-pathnames (make-pathname :name (format nil "snapshot-~a" timetag) + (copy-file snapshot (merge-pathnames (make-pathname :name (get-snapshot-filename timetag) :type (get-file-extension system)) snapshot))) (with-open-file (out snapshot :direction :output :if-does-not-exist :create :if-exists :supersede) (funcall (get-serializer system) (get-root-objects system) out *serialization-state*)) (when (probe-file transaction-log) - (copy-file transaction-log (merge-pathnames (make-pathname :name (format nil "transaction-log-~a" timetag) + (copy-file transaction-log (merge-pathnames (make-pathname :name (get-transaction-log-filename timetag) :type (get-file-extension system)) transaction-log)) (delete-file transaction-log)))) @@ -249,10 +242,10 @@ (let* ((timetag (timetag)) (transaction-log (get-transaction-log system)) (snapshot (get-snapshot system)) - (transaction-log-backup (merge-pathnames (make-pathname :name (format nil "transaction-log-~a" timetag) + (transaction-log-backup (merge-pathnames (make-pathname :name (get-transaction-log-filename timetag) :type (get-file-extension system)) (or directory transaction-log))) - (snapshot-backup (merge-pathnames (make-pathname :name (format nil "snapshot-~a" timetag) + (snapshot-backup (merge-pathnames (make-pathname :name (get-snapshot-filename timetag) :type (get-file-extension system)) (or directory snapshot)))) (close-open-streams system) @@ -273,7 +266,9 @@ (let ((position 0)) (handler-bind ((s-xml:xml-parser-error #'(lambda (condition) - (format t ";; Warning: error during transaction log restore: ~s~%" condition) + (format *standard-output* + ";; Warning: error during transaction log restore: ~s~%" + condition) (truncate-file (get-transaction-log system) position) (return-from restore)))) (with-open-file (in (get-transaction-log system) :direction :input) @@ -284,6 +279,51 @@ (execute-on transaction system) (return))))))))) +(defmethod execute ((system guarded-prevalence-system) (transaction transaction)) + "Execute a transaction on a system controlled by a guard" + (funcall (get-guard system) + #'(lambda () (call-next-method system transaction)))) + +(defmethod query ((system guarded-prevalence-system) function &rest args) + "Execute an exclusive query function on a sytem controlled by a guard" + (funcall (get-guard system) + #'(lambda () (apply function (cons system args))))) + +(defmethod snapshot ((system guarded-prevalence-system)) + "Make a snapshot of a system controlled by a guard" + (funcall (get-guard system) + #'(lambda () (call-next-method system)))) + +(defmethod backup ((system guarded-prevalence-system) &key directory) + "Do a backup on a system controlled by a guard" + (funcall (get-guard system) + #'(lambda () (call-next-method system directory)))) + +(defmethod restore ((system guarded-prevalence-system)) + "Restore a system controlled by a guard" + (funcall (get-guard system) + #'(lambda () (call-next-method system)))) + +;;; Some utilities + +(defun timetag (&optional (universal-time (get-universal-time))) + "Return a GMT string of universal-time as YYMMDDTHHMMSS" + (multiple-value-bind (second minute hour date month year) + (decode-universal-time universal-time 0) + (format nil + "~d~2,'0d~2,'0dT~2,'0d~2,'0d~2,'0d" + year month date hour minute second))) + +(defmethod get-transaction-log-filename ((system prevalence-system) &optional suffix) + "Return the name of the transaction-log filename, optionally using a suffix" + (format nil "transaction-log@[-~a]" suffix)) + +(defmethod get-snapshot-filename ((system prevalence-system) &optional suffix) + "Return the name of the snapshot filename, optionally using a suffix" + (format nil "snapshot@[-~a]" suffix)) + +;;; Some file manipulation utilities + (defun truncate-file (file position) "Truncate the physical file at position by copying and replacing it" (let ((tmp-file (merge-pathnames (concatenate 'string "tmp-" (pathname-name file)) file)) @@ -314,11 +354,7 @@ (write-sequence buffer out :end read-count) (when (< read-count 4096) (return))))))) -(defmethod initiates-rollback ((condition condition)) - t) - -(defmethod initiates-rollback ((no-rollback-error no-rollback-error)) - nil) +;;; extra documentation (setf (documentation 'get-guard 'function) "Access the guard function of a sytem")

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/test-prevalence.lisp
by Sven Van Caekenberghe 25 Jun '04

25 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv13767/test Modified Files: test-prevalence.lisp Log Message: we now call close-open-streams because windos chokes on this when the file is later deleted Date: Fri Jun 25 09:19:05 2004 Author: scaekenberghe Index: cl-prevalence/test/test-prevalence.lisp diff -u cl-prevalence/test/test-prevalence.lisp:1.1.1.1 cl-prevalence/test/test-prevalence.lisp:1.2 --- cl-prevalence/test/test-prevalence.lisp:1.1.1.1 Sun Jun 20 12:13:42 2004 +++ cl-prevalence/test/test-prevalence.lisp Fri Jun 25 09:19:05 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: test-prevalence.lisp,v 1.1.1.1 2004/06/20 19:13:42 scaekenberghe Exp $ +;;;; $Id: test-prevalence.lisp,v 1.2 2004/06/25 16:19:05 scaekenberghe Exp $ ;;;; ;;;; Testing Object Prevalence in Common Lisp ;;;; @@ -12,11 +12,13 @@ (in-package :cl-prevalence) -(defvar *test-system*) +(defparameter *test-system-directory* (pathname "/tmp/test-prevalence-system/")) + +(defvar *test-system* nil) ;; Create a new prevalence system for testing purposes -(let ((directory (pathname "/tmp/test-prevalence-system/"))) +(let ((directory *test-system-directory*)) ;; Throw away any xml files that we find: we want to start from scratch (when (probe-file directory) (dolist (pathname (directory (merge-pathnames "*.xml" directory))) @@ -83,8 +85,8 @@ ;; Throw away the previous prevalence instance and start over, ;; counting on a restore operation using the transaction log -(let ((directory (pathname "/tmp/test-prevalence-system/"))) - (setf *test-system* (make-prevalence-system directory))) +(close-open-streams *test-system*) +(setf *test-system* (make-prevalence-system *test-system-directory*)) (let ((person (gethash *jlp* (get-root-object *test-system* :persons)))) (assert (eq (class-of person) (find-class 'person))) @@ -103,8 +105,8 @@ ;; Throw away the previous prevalence instance and start over, ;; counting on a restore operation using the snapshot -(let ((directory (pathname "/tmp/test-prevalence-system/"))) - (setf *test-system* (make-prevalence-system directory))) +(close-open-streams *test-system*) +(setf *test-system* (make-prevalence-system *test-system-directory*)) (let ((person (gethash *jlp* (get-root-object *test-system* :persons)))) (assert (eq (class-of person) (find-class 'person))) @@ -129,8 +131,8 @@ ;; Throw away the previous prevalence instance and start over, ;; counting on a restore operation using both the snapshot and the transaction log -(let ((directory (pathname "/tmp/test-prevalence-system/"))) - (setf *test-system* (make-prevalence-system directory))) +(close-open-streams *test-system*) +(setf *test-system* (make-prevalence-system *test-system-directory*)) (let ((person (gethash *jlp* (get-root-object *test-system* :persons)))) (assert (eq (class-of person) (find-class 'person))) @@ -156,9 +158,10 @@ (setf *guard* t) (funcall thunk)) -(let ((directory (pathname "/tmp/test-prevalence-system/"))) - (setf *test-system* (make-prevalence-system directory :prevalence-system-class 'guarded-prevalence-system)) - (setf (get-guard *test-system*) #'guard)) +(close-open-streams *test-system*) +(setf *test-system* (make-prevalence-system *test-system-directory* + :prevalence-system-class 'guarded-prevalence-system)) +(setf (get-guard *test-system*) #'guard) (let (new-person) (setf *guard* nil)

1 0

[cl-prevalence-cvs] CVS update: public_html/index.html
by Sven Van Caekenberghe 24 Jun '04

24 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv17154 Modified Files: index.html Log Message: added download links Date: Thu Jun 24 00:23:40 2004 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.4 public_html/index.html:1.5 --- public_html/index.html:1.4 Mon Jun 21 07:34:01 2004 +++ public_html/index.html Thu Jun 24 00:23:40 2004 @@ -52,8 +52,10 @@ <h3>Download</h3> <p> - This project is currently starting up, please use - <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-prevalence">CVS</a> access for now, which also offers a tarball. + You can download the LLGPL source code and documentation as <a href="cl-prevalence.tgz">cl-prevalence.tgz</a> + (signature: <a href="cl-prevalence.tgz.asc">cl-prevalence.tgz.asc</a>) + (build and/or install with ASDF). + There is also <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-prevalence">CVS</a> access. </p> <h3>API</h3> @@ -79,7 +81,7 @@ <li><a href="http://common-lisp.net/mailman/listinfo/cl-prevalence-announce">CL-PREVALENCE-ANNOUNCE mailing list info</a></li> </ul> - <p>CVS version $Id: index.html,v 1.4 2004/06/21 14:34:01 scaekenberghe Exp $</p> + <p>CVS version $Id: index.html,v 1.5 2004/06/24 07:23:40 scaekenberghe Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/Makefile
by Sven Van Caekenberghe 24 Jun '04

24 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv14572 Modified Files: Makefile Log Message: fixed release target Date: Thu Jun 24 00:23:05 2004 Author: scaekenberghe Index: cl-prevalence/Makefile diff -u cl-prevalence/Makefile:1.1.1.1 cl-prevalence/Makefile:1.2 --- cl-prevalence/Makefile:1.1.1.1 Sun Jun 20 12:13:38 2004 +++ cl-prevalence/Makefile Thu Jun 24 00:23:05 2004 @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.1.1.1 2004/06/20 19:13:38 scaekenberghe Exp $ +# $Id: Makefile,v 1.2 2004/06/24 07:23:05 scaekenberghe Exp $ default: @echo Possible targets: @@ -24,12 +24,12 @@ PRJ=cl-prevalence ACCOUNT=scaekenberghe -CVSRT=:ext:$ACCOUNT@common-lisp.net:/project/$PRJ/cvsroot +CVSRT=:ext:$(ACCOUNT)@common-lisp.net:/project/$(PRJ)/cvsroot release: - rm -rf /tmp/$PRJ /tmp/public_html /tmp/$PRJ.tgz /tmp/$PRJ.tgz.asc - cd /tmp; cvs -d$CVSRT export -r HEAD $PRJ; cvs -d$CVSRT export -r HEAD public_html - mv /tmp/public_html /tmp/$PRJ/doc - cd /tmp; gnutar cvfz $PRJ.tgz $PRJ; gpg -a -b $PRJ.tgz - scp /tmp/$PRJ.tgz $ACCOUNT@common-lisp.net:/project/$PRJ/public_html - scp /tmp/$PRJ.tgz.asc $ACCOUNT@common-lisp.net:/project/$PRJ/public_html + rm -rf /tmp/$(PRJ) /tmp/public_html /tmp/$(PRJ).tgz /tmp/$(PRJ).tgz.asc + cd /tmp; cvs -d$(CVSRT) export -r HEAD $(PRJ); cvs -d$(CVSRT) export -r HEAD public_html + mv /tmp/public_html /tmp/$(PRJ)/doc + cd /tmp; gnutar cvfz $(PRJ).tgz $(PRJ); gpg -a -b $(PRJ).tgz + scp /tmp/$(PRJ).tgz $(ACCOUNT)@common-lisp.net:/project/$(PRJ)/public_html + scp /tmp/$(PRJ).tgz.asc $(ACCOUNT)@common-lisp.net:/project/$(PRJ)/public_html

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/demo1.lisp
by Sven Van Caekenberghe 22 Jun '04

22 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv14563/test Modified Files: demo1.lisp Log Message: more work on integrating sexp serialization added benchmark2 Date: Tue Jun 22 01:37:23 2004 Author: scaekenberghe Index: cl-prevalence/test/demo1.lisp diff -u cl-prevalence/test/demo1.lisp:1.2 cl-prevalence/test/demo1.lisp:1.3 --- cl-prevalence/test/demo1.lisp:1.2 Mon Jun 21 08:26:21 2004 +++ cl-prevalence/test/demo1.lisp Tue Jun 22 01:37:23 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: demo1.lisp,v 1.2 2004/06/21 15:26:21 scaekenberghe Exp $ +;;;; $Id: demo1.lisp,v 1.3 2004/06/22 08:37:23 scaekenberghe Exp $ ;;;; ;;;; A Common Lisp version of the the Java Prevalyer demo1 example ;;;; @@ -64,6 +64,19 @@ (defun benchmark1 () (let (system) (setf system (make-prevalence-system *system-location*)) + (totally-destroy system) + (execute system (make-transaction 'tx-create-numbers-root)) + (time (dotimes (i 10000) (execute system (make-transaction 'tx-add-number i)))) + (close-open-streams system) + (setf system (time (make-prevalence-system *system-location*))) + (close-open-streams system))) + +(defun benchmark2 () + (let (system) + (setf system (make-prevalence-system *system-location* + :init-args '(:serializer serialize-sexp + :deserializer deserialize-sexp + :file-extension "sexp"))) (totally-destroy system) (execute system (make-transaction 'tx-create-numbers-root)) (time (dotimes (i 10000) (execute system (make-transaction 'tx-add-number i))))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/prevalence.lisp cl-prevalence/src/serialization.lisp
by Sven Van Caekenberghe 22 Jun '04

22 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv14563/src Modified Files: prevalence.lisp serialization.lisp Log Message: more work on integrating sexp serialization added benchmark2 Date: Tue Jun 22 01:37:23 2004 Author: scaekenberghe Index: cl-prevalence/src/prevalence.lisp diff -u cl-prevalence/src/prevalence.lisp:1.2 cl-prevalence/src/prevalence.lisp:1.3 --- cl-prevalence/src/prevalence.lisp:1.2 Mon Jun 21 08:26:21 2004 +++ cl-prevalence/src/prevalence.lisp Tue Jun 22 01:37:23 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: prevalence.lisp,v 1.2 2004/06/21 15:26:21 scaekenberghe Exp $ +;;;; $Id: prevalence.lisp,v 1.3 2004/06/22 08:37:23 scaekenberghe Exp $ ;;;; ;;;; Object Prevalence in Common Lisp ;;;; @@ -14,12 +14,12 @@ ;;; Public API: Functions and Generic Functions -(defun make-prevalence-system (directory &key (prevalence-system-class 'prevalence-system)) +(defun make-prevalence-system (directory &key (prevalence-system-class 'prevalence-system) init-args) "Create and return a new prevalence system on directory. When the directory contains a valid snapshot and/or transaction log file, the system will be restored. Optionally specify the prevalence system's class." - (make-instance prevalence-system-class :directory directory)) + (apply #'make-instance prevalence-system-class :directory directory init-args)) (defun make-transaction (function &rest args) "Create and return a new transaction specifying a function name and @@ -87,12 +87,15 @@ :initform nil) (serializer ;; type function :accessor get-serializer + :initarg :serializer :initform #'serialize-xml) (deserializer ;; type function :accessor get-deserializer + :initarg :deserializer :initform #'deserialize-xml) (file-extension ;; type string :accessor get-file-extension + :initarg :file-extension :initform "xml")) (:documentation "Base Prevalence system implementation object")) Index: cl-prevalence/src/serialization.lisp diff -u cl-prevalence/src/serialization.lisp:1.1.1.1 cl-prevalence/src/serialization.lisp:1.2 --- cl-prevalence/src/serialization.lisp:1.1.1.1 Sun Jun 20 12:13:41 2004 +++ cl-prevalence/src/serialization.lisp Tue Jun 22 01:37:23 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: serialization.lisp,v 1.1.1.1 2004/06/20 19:13:41 scaekenberghe Exp $ +;;;; $Id: serialization.lisp,v 1.2 2004/06/22 08:37:23 scaekenberghe Exp $ ;;;; ;;;; XML and S-Expression based Serialization for Common Lisp and CLOS ;;;; @@ -45,8 +45,8 @@ (reset serialization-state) (let ((sexp (read stream nil :eof))) (if (eq sexp :eof) - (error "Unexpected end of file while deserializing from s-expression")) - (deserialize-sexp-internal sexp (get-hashtable serialization-state)))) + nil + (deserialize-sexp-internal sexp (get-hashtable serialization-state))))) (defun make-serialization-state () "Create a reusable serialization state to pass as optional argument to [de]serialize-xml" @@ -102,6 +102,7 @@ ((eq package +keyword-package+) (write-char #\: stream)) (t (write-string (package-name package) stream) (write-string "::" stream))) + ;; this is *NOT* correct for unprintable symbols !! (write-string name stream))) (defmethod serializable-slots ((object structure-object))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/test/demo1.lisp
by Sven Van Caekenberghe 21 Jun '04

21 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/test In directory common-lisp.net:/tmp/cvs-serv18557/test Modified Files: demo1.lisp Log Message: preparing to support new serialization protocol Date: Mon Jun 21 08:26:21 2004 Author: scaekenberghe Index: cl-prevalence/test/demo1.lisp diff -u cl-prevalence/test/demo1.lisp:1.1.1.1 cl-prevalence/test/demo1.lisp:1.2 --- cl-prevalence/test/demo1.lisp:1.1.1.1 Sun Jun 20 12:13:41 2004 +++ cl-prevalence/test/demo1.lisp Mon Jun 21 08:26:21 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: demo1.lisp,v 1.1.1.1 2004/06/20 19:13:41 scaekenberghe Exp $ +;;;; $Id: demo1.lisp,v 1.2 2004/06/21 15:26:21 scaekenberghe Exp $ ;;;; ;;;; A Common Lisp version of the the Java Prevalyer demo1 example ;;;; @@ -61,18 +61,12 @@ (incf candidate))) (close-open-streams system)))) -(defun reset-demo1 () - "Throw away any xml files that we find: we want to start from scratch" - (when (probe-file *system-location*) - (dolist (pathname (directory (merge-pathnames "*.xml" *system-location*))) - (delete-file pathname)))) - (defun benchmark1 () - (reset-demo1) (let (system) (setf system (make-prevalence-system *system-location*)) + (totally-destroy system) (execute system (make-transaction 'tx-create-numbers-root)) - (time (dotimes (i 1000) (execute system (make-transaction 'tx-add-number i)))) + (time (dotimes (i 10000) (execute system (make-transaction 'tx-add-number i)))) (close-open-streams system) (setf system (time (make-prevalence-system *system-location*))) (close-open-streams system)))

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/package.lisp cl-prevalence/src/prevalence.lisp
by Sven Van Caekenberghe 21 Jun '04

21 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv18557/src Modified Files: package.lisp prevalence.lisp Log Message: preparing to support new serialization protocol Date: Mon Jun 21 08:26:21 2004 Author: scaekenberghe Index: cl-prevalence/src/package.lisp diff -u cl-prevalence/src/package.lisp:1.2 cl-prevalence/src/package.lisp:1.3 --- cl-prevalence/src/package.lisp:1.2 Mon Jun 21 07:38:39 2004 +++ cl-prevalence/src/package.lisp Mon Jun 21 08:26:21 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: package.lisp,v 1.2 2004/06/21 14:38:39 scaekenberghe Exp $ +;;;; $Id: package.lisp,v 1.3 2004/06/21 15:26:21 scaekenberghe Exp $ ;;;; ;;;; Package definitions for the CL-PREVALENCE project ;;;; @@ -39,6 +39,7 @@ #:transaction #:no-rollback-error #:initiates-rollback + #:totally-destroy #:print-transaction-log #:show-transaction-log #:print-snapshot #:transaction-log-tail Index: cl-prevalence/src/prevalence.lisp diff -u cl-prevalence/src/prevalence.lisp:1.1.1.1 cl-prevalence/src/prevalence.lisp:1.2 --- cl-prevalence/src/prevalence.lisp:1.1.1.1 Sun Jun 20 12:13:39 2004 +++ cl-prevalence/src/prevalence.lisp Mon Jun 21 08:26:21 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: Lisp -*- ;;;; -;;;; $Id: prevalence.lisp,v 1.1.1.1 2004/06/20 19:13:39 scaekenberghe Exp $ +;;;; $Id: prevalence.lisp,v 1.2 2004/06/21 15:26:21 scaekenberghe Exp $ ;;;; ;;;; Object Prevalence in Common Lisp ;;;; @@ -64,6 +64,9 @@ (defgeneric backup (system &key directory) (:documentation "Make backup copies of the current snapshot and transaction-log files")) +(defgeneric totally-destroy (system &key abort) + (:documentation "Totally destroy system from permanent storage by deleting any files that we find")) + ;;; Classes (defclass prevalence-system () @@ -81,7 +84,16 @@ :accessor get-transaction-log) (transaction-log-stream ;; :type stream :accessor get-transaction-log-stream - :initform nil)) + :initform nil) + (serializer ;; type function + :accessor get-serializer + :initform #'serialize-xml) + (deserializer ;; type function + :accessor get-deserializer + :initform #'deserialize-xml) + (file-extension ;; type string + :accessor get-file-extension + :initform "xml")) (:documentation "Base Prevalence system implementation object")) (defclass guarded-prevalence-system (prevalence-system) @@ -114,8 +126,11 @@ (declare (ignore initargs)) (with-slots (directory) system (ensure-directories-exist directory) - (setf (get-snapshot system) (merge-pathnames "snapshot.xml" directory) - (get-transaction-log system) (merge-pathnames "transaction-log.xml" directory))) + (setf (get-snapshot system) (merge-pathnames (make-pathname :name "snapshot" :type (get-file-extension system)) + directory) + (get-transaction-log system) (merge-pathnames (make-pathname :name "transaction-log" + :type (get-file-extension system)) + directory))) (restore system)) (defmethod get-transaction-log-stream :before ((system prevalence-system)) @@ -134,11 +149,13 @@ (setf transaction-log-stream nil)))) (defmethod totally-destroy ((system prevalence-system) &key abort) - "Totally destroy system from permanent storage by deleting any xml files that we find" + "Totally destroy system from permanent storage by deleting any files that we find" (close-open-streams system :abort abort) (when (probe-file (get-directory system)) - (dolist (pathname (directory (merge-pathnames "*.xml" (get-directory system)))) - (delete-file pathname)))) + (dolist (pathname (directory (merge-pathnames (make-pathname :type (get-file-extension system)) + (get-directory system)))) + (delete-file pathname))) + (clrhash (get-root-objects system))) (defmethod print-object ((transaction transaction) stream) (format stream "#<TRANSACTION ~a ~a>" @@ -174,7 +191,7 @@ (restore system))))) (execute-on transaction system))) (out (get-transaction-log-stream system))) - (serialize-xml transaction out *serialization-state*) + (funcall (get-serializer system) transaction out *serialization-state*) (terpri out) (finish-output out) result)) @@ -212,12 +229,16 @@ (snapshot (get-snapshot system))) (close-open-streams system) (when (probe-file snapshot) - (copy-file snapshot (merge-pathnames (format nil "snapshot-~a.xml" timetag) snapshot))) + (copy-file snapshot (merge-pathnames (make-pathname :name (format nil "snapshot-~a" timetag) + :type (get-file-extension system)) + snapshot))) (with-open-file (out snapshot :direction :output :if-does-not-exist :create :if-exists :supersede) - (serialize-xml (get-root-objects system) out *serialization-state*)) + (funcall (get-serializer system) (get-root-objects system) out *serialization-state*)) (when (probe-file transaction-log) - (copy-file transaction-log (merge-pathnames (format nil "transaction-log-~a.xml" timetag) transaction-log)) + (copy-file transaction-log (merge-pathnames (make-pathname :name (format nil "transaction-log-~a" timetag) + :type (get-file-extension system)) + transaction-log)) (delete-file transaction-log)))) (defmethod backup ((system prevalence-system) &key directory) @@ -225,9 +246,11 @@ (let* ((timetag (timetag)) (transaction-log (get-transaction-log system)) (snapshot (get-snapshot system)) - (transaction-log-backup (merge-pathnames (format nil "transaction-log-~a.xml" timetag) + (transaction-log-backup (merge-pathnames (make-pathname :name (format nil "transaction-log-~a" timetag) + :type (get-file-extension system)) (or directory transaction-log))) - (snapshot-backup (merge-pathnames (format nil "snapshot-~a.xml" timetag) + (snapshot-backup (merge-pathnames (make-pathname :name (format nil "snapshot-~a" timetag) + :type (get-file-extension system)) (or directory snapshot)))) (close-open-streams system) (when (probe-file transaction-log) @@ -242,7 +265,7 @@ (close-open-streams system) (when (probe-file (get-snapshot system)) (with-open-file (in (get-snapshot system) :direction :input) - (setf (get-root-objects system) (deserialize-xml in *serialization-state*)))) + (setf (get-root-objects system) (funcall (get-deserializer system) in *serialization-state*)))) (when (probe-file (get-transaction-log system)) (let ((position 0)) (handler-bind ((s-xml:xml-parser-error @@ -252,7 +275,7 @@ (return-from restore)))) (with-open-file (in (get-transaction-log system) :direction :input) (loop - (let ((transaction (deserialize-xml in *serialization-state*))) + (let ((transaction (funcall (get-deserializer system) in *serialization-state*))) (setf position (file-position in)) (if transaction (execute-on transaction system)

1 0

[cl-prevalence-cvs] CVS update: cl-prevalence/src/package.lisp
by Sven Van Caekenberghe 21 Jun '04

21 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence/src In directory common-lisp.net:/tmp/cvs-serv24685/src Modified Files: package.lisp Log Message: exported sexp serializations functions Date: Mon Jun 21 07:38:39 2004 Author: scaekenberghe Index: cl-prevalence/src/package.lisp diff -u cl-prevalence/src/package.lisp:1.1.1.1 cl-prevalence/src/package.lisp:1.2 --- cl-prevalence/src/package.lisp:1.1.1.1 Sun Jun 20 12:13:39 2004 +++ cl-prevalence/src/package.lisp Mon Jun 21 07:38:39 2004 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: package.lisp,v 1.1.1.1 2004/06/20 19:13:39 scaekenberghe Exp $ +;;;; $Id: package.lisp,v 1.2 2004/06/21 14:38:39 scaekenberghe Exp $ ;;;; ;;;; Package definitions for the CL-PREVALENCE project ;;;; @@ -14,8 +14,8 @@ (:use :cl) (:export #:serializable-slots - #:serialize-xml - #:deserialize-xml + #:serialize-xml #:serialize-sexp + #:deserialize-xml #:deserialize-sexp #:make-serialization-state) (:documentation "XML and s-expression based serialization for Common Lisp and CLOS")) @@ -72,6 +72,6 @@ #:get-preference #:all-preferences-keys #:tx-set-preference) - (:documentation "A proof of concept Common Lisp Prevalence system")) + (:documentation "An implementation of Object Prevalence for Common Lisp")) ;;;; eof

1 0

[cl-prevalence-cvs] CVS update: public_html/CL-PREVALENCE.html public_html/S-SERIALIZATION.html public_html/index.html
by Sven Van Caekenberghe 21 Jun '04

21 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv15463 Modified Files: index.html Added Files: CL-PREVALENCE.html S-SERIALIZATION.html Log Message: added more info Date: Mon Jun 21 07:34:01 2004 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.3 public_html/index.html:1.4 --- public_html/index.html:1.3 Sun Jun 20 13:11:49 2004 +++ public_html/index.html Mon Jun 21 07:34:01 2004 @@ -15,12 +15,61 @@ <p>CL-PREVALENCE is an implementation of <a href="http://www.prevayler.org">Object Prevalence</a> for Common Lisp.</p> +<p> + Object Prevalence is a simple but interesting concept first proposed by Klaus Wuestefeld in 2001. IBM developerWorks has a reasonable <a href="http://www-106.ibm.com/developerworks/library/wa-objprev/">Introduction to Object Prevalence</a> article. The main Java implementation is called <a href="http://www.prevayler.org">Prevayler</a>, with a (chaotic) wiki site with lots of information and discussions. Basically, the idea is this: +</p> +<ul> + <li>Most databases are only a couple of hundreds of megabytes big, often even less.</li> + <li>Most computers can easily take a couple of hundreds of megabytes of data in RAM, big servers can hold many gigabytes.</li> + <li>Mapping objects to databases is at least tedious and time consuming, but often also complex and error prone.</li> + <li>Let's throw away the database and just consider the domain model objects as the database.</li> + <li>Let's make sure we can serialize and deserialize our objects to and from a some presistent medium such as a file system.</li> + <li>If we store our complete set of domain model objects to a persistent medium we create a <em>snapshot</em>.</li> + <li>We query by using the data structure manipulation functionality of our programming language, running from RAM, queries will be extremely fast.</li> + <li>Let's agree to only change our object model using transaction objects that combine the data and the functionality to execute the transaction.</li> + <li>In order to preserve the ACID properties of our system, we log each transaction to some persistent medium by serializing it after we execute it. The is called the <em>transaction log</em>.</li> + <li>When the system goes down (intentionally or unintentionally) we restore its latest state by first reading in the latest snapshot and by re-executing each transaction from the transaction log.</li> + <li>Transactions must be deterministic and re-entrant (so they also need to record the current time if necessary).</li> + <li>In a multi-threaded system, transactions are globally serialized.</li> +</ul> +<p> +That is all there is to the concept of object prevalence. Here are some more details as well as some advantages and limitations: +</p> +<ul> + <li>A good implementation on a modern machine can achieve thousands of transactions per second, and recover them at about the same speed.</li> + <li>Transactions must be short because they block the system - since everything is in RAM this is not a problem.</li> + <li>Queries that need to see a completely consistent system state must also block on the system - other less critical queries could run in parallel.</li> + <li>It is practical for a transaction to first check its preconditions, throw an error if necessary, and to only modify the system when everything is consistent. During a transaction you are the sole active thread. Queries are as fast as they can get. In this implementation transactions are logged after succesful execution.</li> + <li>In this implementation there is an option to do a rollback (by doing a system restore) when an unexpected error occurs during transaction execution. You can specifiy that a condition doesn't need a rollback when it occurs inside a transaction by implementing the <tt>initiates-rollback</tt> to return false (or by using the <tt>no-rollback-error</tt> condition or inheriting from it).</li> + <li>Long running transactions are an open question.</li> + <li>Application server techniques are used to offer multiple clients access to the same prevalence system.</li> + <li>We can easily do replication (and query load balancing) by distributing the master transaction log stream to replica's that can host queries, execute backups (snapshots) or serve as hot fail-over. This implementation does not yet contain replication.</li> +</ul> +<p> + This code was written by Sven Van Caekenberghe. +</p> + <h3>Download</h3> + <p> This project is currently starting up, please use <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-prevalence">CVS</a> access for now, which also offers a tarball. </p> +<h3>API</h3> + + <p> + You can consult the LispDoc generated API is the files <a href="CL-PREVALENCE.html">CL-PREVALENCE.html</a> + and <a href="S-SERIALIZATION.html">S-SERIALIZATION.html</a>. + </p> + +<h3>Release History</h3> + +<ul> + <li>release 3, today: move to common-lisp.net, added s-expression based serialization</li> + <li>release 2, Januari 13, 2004: added managed-prevalence layer, generic persistent preferences and a blob feature, as well as several useful functions to support development and deployment</li> + <li>release 1, June 10, 2003: first public release</li> +</ul> <h3>Mailing Lists</h3> @@ -30,7 +79,7 @@ <li><a href="http://common-lisp.net/mailman/listinfo/cl-prevalence-announce">CL-PREVALENCE-ANNOUNCE mailing list info</a></li> </ul> - <p>CVS version $Id: index.html,v 1.3 2004/06/20 20:11:49 scaekenberghe Exp $</p> + <p>CVS version $Id: index.html,v 1.4 2004/06/21 14:34:01 scaekenberghe Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[cl-prevalence-cvs] CVS update: public_html/index.html
by Sven Van Caekenberghe 20 Jun '04

20 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv6586 Modified Files: index.html Log Message: wrong cvs link Date: Sun Jun 20 13:11:49 2004 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.2 public_html/index.html:1.3 --- public_html/index.html:1.2 Sun Jun 20 12:31:03 2004 +++ public_html/index.html Sun Jun 20 13:11:49 2004 @@ -18,7 +18,7 @@ <h3>Download</h3> <p> This project is currently starting up, please use - <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=s-xml">CVS</a> access for now, which also offers a tarball. + <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-prevalence">CVS</a> access for now, which also offers a tarball. </p> @@ -30,7 +30,7 @@ <li><a href="http://common-lisp.net/mailman/listinfo/cl-prevalence-announce">CL-PREVALENCE-ANNOUNCE mailing list info</a></li> </ul> - <p>CVS version $Id: index.html,v 1.2 2004/06/20 19:31:03 scaekenberghe Exp $</p> + <p>CVS version $Id: index.html,v 1.3 2004/06/20 20:11:49 scaekenberghe Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[cl-prevalence-cvs] CVS update: public_html/index.html
by Sven Van Caekenberghe 20 Jun '04

20 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv27228 Modified Files: index.html Log Message: fixed a link Date: Sun Jun 20 12:31:03 2004 Author: scaekenberghe Index: public_html/index.html diff -u public_html/index.html:1.1 public_html/index.html:1.2 --- public_html/index.html:1.1 Sun Jun 20 12:22:58 2004 +++ public_html/index.html Sun Jun 20 12:31:03 2004 @@ -13,7 +13,7 @@ <h1>CL-PREVALENCE</h1> </div> - <p>CL-PREVALENCE is an implementation of <a href="http://www.advogato.org/article/398.html">Object Prevalence</a> for Common Lisp.</p> + <p>CL-PREVALENCE is an implementation of <a href="http://www.prevayler.org">Object Prevalence</a> for Common Lisp.</p> <h3>Download</h3> <p> @@ -30,7 +30,7 @@ <li><a href="http://common-lisp.net/mailman/listinfo/cl-prevalence-announce">CL-PREVALENCE-ANNOUNCE mailing list info</a></li> </ul> - <p>CVS version $Id: index.html,v 1.1 2004/06/20 19:22:58 scaekenberghe Exp $</p> + <p>CVS version $Id: index.html,v 1.2 2004/06/20 19:31:03 scaekenberghe Exp $</p> <div class="footer"> <p>Back to <a href="http://common-lisp.net/">Common-lisp.net</a>.</p>

1 0

[cl-prevalence-cvs] CVS update: public_html/index.html public_html/style.css
by Sven Van Caekenberghe 20 Jun '04

20 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv10699 Added Files: index.html style.css Log Message: first content Date: Sun Jun 20 12:22:58 2004 Author: scaekenberghe

1 0

[cl-prevalence-cvs] CVS update: Module imported: public_html
by Sven Van Caekenberghe 20 Jun '04

20 Jun '04

Update of /project/cl-prevalence/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv31021 Log Message: Project Creation Status: Vendor Tag: svc Release Tags: start No conflicts created by this import Date: Sun Jun 20 12:14:29 2004 Author: scaekenberghe New module public_html added

1 0

[cl-prevalence-cvs] CVS update: Module imported: cl-prevalence
by Sven Van Caekenberghe 20 Jun '04

20 Jun '04

Update of /project/cl-prevalence/cvsroot/cl-prevalence In directory common-lisp.net:/tmp/cvs-serv26888 Log Message: Project Creation Status: Vendor Tag: svc Release Tags: start N cl-prevalence/cl-prevalence.asd N cl-prevalence/Makefile N cl-prevalence/src/blob.lisp N cl-prevalence/src/debug-prevalence.lisp N cl-prevalence/src/managed-prevalence.lisp N cl-prevalence/src/package.lisp N cl-prevalence/src/prevalence.lisp N cl-prevalence/src/serialization.lisp N cl-prevalence/test/demo1.lisp N cl-prevalence/test/demo2.lisp N cl-prevalence/test/test-prevalence.lisp N cl-prevalence/test/test-serialization.lisp No conflicts created by this import Date: Sun Jun 20 12:13:42 2004 Author: scaekenberghe New module cl-prevalence added

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

cl-prevalence-cvs June 2004