Update of /project/elephant/cvsroot/elephant/src/contrib/eslick In directory clnet:/tmp/cvs-serv12311/src/contrib/eslick Added Files: tools.lisp Log Message: Significant additions to the 0.6.0 release on the trunk. Updates to documentation, 0.5.0 compliance, final on 0.6.0 features. There are one or two BDB interactions on migration to work out but this should be a nearly code complete 0.6.0 release. Please start testing and evaluating this - especially the ability to open and tag 0.5.0 databases. Features: - Database version tagging - Support for 0.5.0 namespaces & databases - New migration system - class indexing without slot indexing - various bug fixes - reverted fast allegro/sbcl string support to allow 0.5.0 databases to work correctly. I couldn't find a good way to work around this without creating infinite headaches - validated that running db_deadlock will stop all lisp freezes that I've encountered. This has to be run each time a DB environment is opened/created so eventually should be made part of the open-controller functionality for the BDB backend --- /project/elephant/cvsroot/elephant/src/contrib/eslick/tools.lisp 2006/04/26 17:53:44 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/eslick/tools.lisp 2006/04/26 17:53:44 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; tools.lisp -- use btree collections to track objects by slot values ;;; via metaclass options or accessor :after methods ;;; ;;; Initial version 3/29/2006 Ian Eslick ;;; eslick at alum mit edu ;;; ;;; License: Lisp Limited General Public License (LLGPL) ;;; http://www.franz.com/preamble.html ;;; (in-package :elephant) ;; ;; Messy method to see what's in a btree ;; (defmethod summarize-btree-contents ((btree btree) &key (print-depth 100) (search-depth nil) (dump nil) (recurse nil)) (let ((count 0) (record (make-btree-summary-record))) (catch 'max-depth (map-btree (lambda (key val) (incf count) (when (and search-depth (> count search-depth)) (throw 'max-depth nil)) (update-stats-for-value val record) (when (and dump (< count print-depth)) (format t "key: ~A value: ~A~%" key val)) (when (and recurse (subtypep (type-of val) 'btree) (< count print-depth)) (format t "Recursing into ~A:~A...~%" key val) (summarize-btree-contents val :search-depth search-depth :print-depth print-depth :dump dump :recurse recurse) (format t "...completing recursion into ~A:~A~%" key val))) btree)) (format t "Summary:~%") (loop for pair in record do (cond ((eq (car pair) 'array) (format t "~A (~A)~%" (symbol-name (car pair)) (- (cdr pair) (cdr (assoc 'string record))))) (t (format t "~A (~A)~%" (symbol-name (car pair)) (cdr pair))))))) (defparameter *base-types* '(persistent-object persistent-collection structure-object standard-object number string array hash-table)) (defun make-btree-summary-record () (let ((record nil)) (loop for type in *base-types* do (push (cons (intern type (find-package 'keyword)) 0) record)) record)) (defmethod update-stats-for-value (value record) (loop for type in *base-types* do (when (subtypep (type-of value) type) (incf (cdr (assoc (intern type (find-package 'keyword)) record))))))