[naviserver-commits] naviserver/tcl cache.tcl,NONE,1.1

[Stephen D. <sd...@us...>]

Update of /cvsroot/naviserver/naviserver/tcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32584/tcl

Added Files:
	cache.tcl 
Log Message:
2005-12-30  Stephen Deasey  <sd...@us...>

        * include/ns.h:
        * nsd/nsd.h:
        * nsd/init.c:
        * nsd/proc.c:
        * nsd/cache.c: Global hash of cache names removed; access no
        longer available via Ns_CacheFind() or ns_cache_names.  Caches
        have unique locking requirements and lifetimes which could be
        violated by e.g. running ns_cache_stats on a thread local cache as the
        thread is exiting.

        New Ns_CacheCreateEx() allows creating a cache which has both a
        size and a time limit.

        Caches with time limits are calculated differently.  Previous
        behaviour was to periodically check the last access time of each
        cache entry and flush those which had expired.  A busy cache could
        grow without bound.  New behaviour is to check for expirey each time
        an entry is retrieved from the cache.  All caches can (and should)
        be size limited.  Timeouts may be specified per cache and per
        entry using new Ns_CacheSetValueExpires().

        Ns_CacheFlush() now returns the number of entries flushed.

        New Ns_CacheStats() takes over from ns_cache_stats for non-Tcl
        caches. Stats are returned in Tcl "array get" format.

        Removed Ns_CacheMalloc(), Ns_CacheFree() and Ns_CacheName().

        Move Tcl commands to tclcache.c.

        * nsd/Makefile:
        * nsd/tclcmds.c:
        * nsd/tclcache.c:
        * tests/ns_cache.test: Add new Tcl commands ns_cache_create,
        _eval, _append, _lappend, and _incr. (RFE# 1119257)

        Old commands ns_cache_names, _keys, _flush and _stats now only
        work on Tcl caches.  ns_cache_size has been removed; the size is
        now reported along with other statistics. These commands now only
        work on Tcl caches.

        * tcl/cache.tcl: New ns_memoize and related commands which act
        just like ns_cache_eval but use the script as a key into the
        memoize cache.


--- NEW FILE: cache.tcl ---
#
# The contents of this file are subject to the Mozilla Public License
# Version 1.1 (the "License"); you may not use this file except in
# compliance with the License. You may obtain a copy of the License at
# http://www.mozilla.org/.
#
# Software distributed under the License is distributed on an "AS IS"
# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
# the License for the specific language governing rights and limitations
# under the License.
#
# The Original Code is AOLserver Code and related documentation
# distributed by AOL.
# 
# The Initial Developer of the Original Code is America Online,
# Inc. Portions created by AOL are Copyright (C) 1999 America Online,
# Inc. All Rights Reserved.
#
# Alternatively, the contents of this file may be used under the terms
# of the GNU General Public License (the "GPL"), in which case the
# provisions of GPL are applicable instead of those above.  If you wish
# to allow use of your version of this file only under the terms of the
# GPL and not to allow others to use your version of this file under the
# License, indicate your decision by deleting the provisions above and
# replace them with the notice and other provisions required by the GPL.
# If you do not delete the provisions above, a recipient may use your
# version of this file under either the License or the GPL.
#

#
# $Header: /cvsroot/naviserver/naviserver/tcl/cache.tcl,v 1.1 2005/12/30 11:07:34 sdeasey Exp $
#

#
# cache.tcl --
#
#     Simple cache for procs and commands.
#

set path "ns/server/[ns_info server]/tcl"
ns_cache_create ns:memoize \
    [ns_config -int $path memoizecache [expr 1024*1024*10]]


proc ns_memoize {args} {
    ns_parseargs {{-timeout ""} {-ttl 0} -- script args} $args

    if {![string equal $timeout ""]} {
        set timeout "-timeout $timeout"
    }
    set key [concat $script $args]
    eval ns_cache_eval $timeout -ttl $ttl -- ns:memoize [list $key] $script $args
}



proc ns_memoize_flush {{pattern ""}} {
    if {[string equal $pattern ""]} {
        return [ns_cache_flush ns:memoize]
    } else {
        return [ns_cache_flush -glob -- ns:memoize $pattern]
    }
}



proc ns_memoize_stats args {
    return [ns_cache_stats ns:memoize]
}