;; persistent-cache.lisp --- ;; Copyright (C) 2008 Clinton Ebadi ;; Author: Clinton Ebadi ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU Lesser General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU Lesser General Public License ;; along with this program. If not, see . (in-package :org.unknownlamer.golgonooza.elephant) (defpclass cacheable-persistent-object () ((object-hash :initform nil :accessor object-hash))) (defpclass persistent-cache-item () ((instance :initarg :instance :accessor cached-instance :index t) (%hash :accessor cached-hash) (%cache :accessor cached-cache))) (defmethod cache-valid-p ((c persistent-cache-item)) (equalp (cached-hash c) (object-hash (cached-instance c)))) (defgeneric update-cache! (persistent-cache-item instance)) (defun find-cached-instance (instance &key (cache-class 'persistent-cache-item)) (or (get-instance-by-value cache-class 'instance instance) (make-instance cache-class :instance instance))) (defmethod (setf cached-cache) :after (new (c persistent-cache-item)) (setf (cached-hash c) (object-hash (cached-instance c)))) ;; update-cache! p-c-i new-cache instead? (defmethod update-cache! :around ((c persistent-cache-item) (i cacheable-persistent-object)) (setf (cached-cache c) (call-next-method))) (defmethod initialize-instance :after ((c persistent-cache-item) &key instance &allow-other-keys) (when instance (update-cache! c (cached-instance c))))