[bknr-cvs] ksprotte changed trunk/projects/bos/m2/
BKNR Commits
bknr at bknr.net
Mon Jul 21 15:14:13 UTC 2008
Revision: 3537
Author: ksprotte
URL: http://bknr.net/trac/changeset/3537
bos: created new subsystem: initialization-subsystem
U trunk/projects/bos/m2/bos.m2.asd
A trunk/projects/bos/m2/initialization-subsystem.lisp
U trunk/projects/bos/m2/m2-store.lisp
U trunk/projects/bos/m2/m2.lisp
Modified: trunk/projects/bos/m2/bos.m2.asd
===================================================================
--- trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:08:54 UTC (rev 3536)
+++ trunk/projects/bos/m2/bos.m2.asd 2008-07-21 15:14:13 UTC (rev 3537)
@@ -13,7 +13,8 @@
(:file "tiled-index" :depends-on ("config"))
(:file "mail-generator" :depends-on ("config"))
(:file "make-certificate" :depends-on ("config"))
- (:file "m2-store" :depends-on ("packages" "utils"))
+ (:file "initialization-subsystem" :depends-on ("packages"))
+ (:file "m2-store" :depends-on ("packages" "utils"))
(:file "m2" :depends-on ("tiled-index"
"utils"
"make-certificate"
Added: trunk/projects/bos/m2/initialization-subsystem.lisp
===================================================================
--- trunk/projects/bos/m2/initialization-subsystem.lisp (rev 0)
+++ trunk/projects/bos/m2/initialization-subsystem.lisp 2008-07-21 15:14:13 UTC (rev 3537)
@@ -0,0 +1,70 @@
+(in-package :bos.m2)
+
+;;; store-transient-init-functions
+;;;
+;;; Allows for registering transient init functions that
+;;; will be called after each restore of m2-store
+
+(defvar *store-transient-init-functions* nil)
+(defvar *store-transient-init-constraints* nil)
+
+(defun register-store-transient-init-function (init-function &rest dependencies)
+ "Register INIT-FUNCTION (a function-name) to be called after
+each restore of m2-store. Optionally, names of other
+init-functions can be specified as DEPENDENCIES. The specified
+INIT-FUNCTION will only be called after all of its DEPENDENCIES
+have been called."
+ (labels ((ignorant-tie-breaker (choices reverse-partial-solution)
+ (declare (ignore reverse-partial-solution))
+ ;; we dont care about making any particular choice here -
+ ;; this would be different for computing the class
+ ;; precedence list, for which the topological-sort used here
+ ;; was originally intended
+ (first choices))
+ (build-constraints ()
+ (loop for dependency in dependencies
+ collect (cons dependency init-function))))
+ (check-type init-function symbol)
+ (dolist (dependency dependencies)
+ (check-type dependency symbol))
+ (let (new-store-transient-init-functions
+ new-store-transient-init-constraints)
+ (let ((constraints (build-constraints))
+ ;; dont know yet whether we have a circular dependency - so
+ ;; we want to be able to abort without changes
+ (*store-transient-init-functions* *store-transient-init-functions*)
+ (*store-transient-init-constraints* *store-transient-init-constraints*))
+ (pushnew init-function *store-transient-init-functions*)
+ (dolist (dependency dependencies)
+ (pushnew dependency *store-transient-init-functions*))
+ (dolist (constraint constraints)
+ (pushnew constraint *store-transient-init-constraints* :test #'equal))
+ (setq new-store-transient-init-functions
+ (topological-sort *store-transient-init-functions*
+ *store-transient-init-constraints*
+ #'ignorant-tie-breaker)
+ new-store-transient-init-constraints
+ *store-transient-init-constraints*))
+ (setq *store-transient-init-functions*
+ new-store-transient-init-functions
+ *store-transient-init-constraints*
+ new-store-transient-init-constraints))))
+
+(defun invoke-store-transient-init-functions ()
+ (dolist (function-name *store-transient-init-functions*)
+ (with-simple-restart (skip-init-function "Skip transient-init-function ~A"
+ function-name)
+ (funcall function-name))))
+
+;;; initialization-subsystem
+(defclass initialization-subsystem ()
+ ())
+
+(defmethod bknr.datastore::restore-subsystem (store (subsystem initialization-subsystem)
+ &key until)
+ (declare (ignore until))
+ (bos.m2::invoke-store-transient-init-functions))
+
+(defmethod bknr.datastore::snapshot-subsystem (store (subsystem initialization-subsystem))
+ )
+
Modified: trunk/projects/bos/m2/m2-store.lisp
===================================================================
--- trunk/projects/bos/m2/m2-store.lisp 2008-07-21 15:08:54 UTC (rev 3536)
+++ trunk/projects/bos/m2/m2-store.lisp 2008-07-21 15:14:13 UTC (rev 3537)
@@ -14,58 +14,3 @@
(setf (slot-value store 'tile-index)
(indexed-class-index-named (find-class 'm2) 'm2-index)))
-;;; store-transient-init-functions
-;;;
-;;; Allows for registering transient init functions that
-;;; will be called after each restore of m2-store
-
-(defvar *store-transient-init-functions* nil)
-(defvar *store-transient-init-constraints* nil)
-
-(defun register-store-transient-init-function (init-function &rest dependencies)
- "Register INIT-FUNCTION (a function-name) to be called after
-each restore of m2-store. Optionally, names of other
-init-functions can be specified as DEPENDENCIES. The specified
-INIT-FUNCTION will only be called after all of its DEPENDENCIES
-have been called."
- (labels ((ignorant-tie-breaker (choices reverse-partial-solution)
- (declare (ignore reverse-partial-solution))
- ;; we dont care about making any particular choice here -
- ;; this would be different for computing the class
- ;; precedence list, for which the topological-sort used here
- ;; was originally intended
- (first choices))
- (build-constraints ()
- (loop for dependency in dependencies
- collect (cons dependency init-function))))
- (check-type init-function symbol)
- (dolist (dependency dependencies)
- (check-type dependency symbol))
- (let (new-store-transient-init-functions
- new-store-transient-init-constraints)
- (let ((constraints (build-constraints))
- ;; dont know yet whether we have a circular dependency - so
- ;; we want to be able to abort without changes
- (*store-transient-init-functions* *store-transient-init-functions*)
- (*store-transient-init-constraints* *store-transient-init-constraints*))
- (pushnew init-function *store-transient-init-functions*)
- (dolist (dependency dependencies)
- (pushnew dependency *store-transient-init-functions*))
- (dolist (constraint constraints)
- (pushnew constraint *store-transient-init-constraints* :test #'equal))
- (setq new-store-transient-init-functions
- (topological-sort *store-transient-init-functions*
- *store-transient-init-constraints*
- #'ignorant-tie-breaker)
- new-store-transient-init-constraints
- *store-transient-init-constraints*))
- (setq *store-transient-init-functions*
- new-store-transient-init-functions
- *store-transient-init-constraints*
- new-store-transient-init-constraints))))
-
-(defun invoke-store-transient-init-functions ()
- (dolist (function-name *store-transient-init-functions*)
- (with-simple-restart (skip-init-function "Skip transient-init-function ~A"
- function-name)
- (funcall function-name))))
\ No newline at end of file
Modified: trunk/projects/bos/m2/m2.lisp
===================================================================
--- trunk/projects/bos/m2/m2.lisp 2008-07-21 15:08:54 UTC (rev 3536)
+++ trunk/projects/bos/m2/m2.lisp 2008-07-21 15:14:13 UTC (rev 3537)
@@ -706,7 +706,8 @@
:subsystems (list (make-instance 'store-object-subsystem)
(make-instance 'blob-subsystem
:n-blobs-per-directory 1000)
- (make-instance 'bos.m2.allocation-cache:allocation-cache-subsystem)))
+ (make-instance 'bos.m2.allocation-cache:allocation-cache-subsystem)
+ (make-instance 'initialization-subsystem)))
(format t "~&; Startup der Quadratmeterdatenbank done.~%")
(force-output))
More information about the Bknr-cvs
mailing list