Index: openacs-4/packages/xotcl-core/www/cache.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/www/cache.tcl,v
diff -u -r1.3 -r1.4
--- openacs-4/packages/xotcl-core/www/cache.tcl 4 Jan 2007 23:54:54 -0000 1.3
+++ openacs-4/packages/xotcl-core/www/cache.tcl 1 Jun 2009 07:45:59 -0000 1.4
@@ -4,6 +4,7 @@
{cache:optional 0}
{item:optional 0}
{flush:optional 0}
+ {filter ""}
{flushall:optional 0}
} -properties {
title:onevalue
@@ -68,11 +69,27 @@
set item_count [llength $item_list]
append output "flush all items of $cache"
- append output "
Items in cache $cache ($item_count) with size [ns_cache_size $cache]
"
+ append output "Items in cache $cache ($item_count) with size [ns_cache_size $cache]
\n"
+ append output "
+ "
+ set entries ""
+ set count 0
foreach name [lsort -dictionary $item_list] {
- append output "- $name (flush)
"
+ set entry [ns_cache get $cache $name]
+ if {$filter ne ""} {if {![regexp $filter $entry]} continue}
+ incr count
+ set n ""
+ regexp -- {-set name ([^\\]+)\\} $entry _ n
+ append entries "- $name $n (flush)
"
}
- append output "
"
+ append entries ""
+ if {$filter ne ""} {
+ append output "$count matching entries:\n"
+ }
+ append output $entries
append output "All Caches"
}