Changeset 3498

Show
Ignore:
Timestamp:
07/18/08 12:33:20 (4 months ago)
Author:
ksprotte
Message:

fixes for contract-tree, especially contract-node-find-corresponding-store-image

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/web/contract-tree.lisp

    r3490 r3498  
    2121(defun contract-node-find-corresponding-store-image (node)   
    2222  (let ((store-images (get-keyword-store-images (contract-node-keyword node)))) 
    23     (when (< 1 (length store-images)) 
    24       (warn "~D store-images for ~S" (length store-images) node)) 
    25     (first store-images))) 
     23    (if (alexandria:length= 1 store-images)      
     24        ;; good, there is only one 
     25        (first store-images) 
     26        ;; We will just return NIL, if we cannot find one. 
     27        ;; If there are too many, we will return the newest one and delete the rest. 
     28        (progn 
     29          (warn "~D store-images for ~S" (length store-images) node) 
     30          (let ((store-images-newest-first 
     31                 (sort (copy-list store-images) #'> :key #'blob-timestamp))) 
     32            (mapc #'delete-object (rest store-images-newest-first)) 
     33            (first store-images-newest-first)))))) 
    2634 
    2735(defmethod initialize-instance :after ((node contract-node) &key args) 
    …… 
    3543(defparameter *contract-tree-images-size* 128) ; was 256 
    3644 
    37 ;;; XXX soll spaeter von was anderem abhaengen 
    3845(defmethod leaf-node-p ((node contract-node)) 
    39   (= 9 (depth node))) 
     46  (= 10 (depth node))) 
    4047 
    4148(defun contract-geo-box (contract) 
    …… 
    297304    (let* ((path (parse-path path)) 
    298305           (node (find-node-with-path *contract-tree* path)) 
    299            (image (image node)))       
     306           (image (image node))) 
     307      (assert image nil "contract-tree node ~{~D~} does not have an image" path) 
    300308      (hunchentoot:handle-if-modified-since (blob-timestamp image)) 
    301309      (with-store-image* (image)