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))