Updated 2004-10-23 02:02:54 by CMCc

The enclosed code (for tclhttpd) provides the [Cache_Fetch] and [Cache_Store] procs which will transparently cache typed content to the filesystem, and return it to the client.

This generic caching allows [Doc_$type] commands to serve cached generated content by processing a file of $type. An example of this is the application/x-tcl-session handler in tclhttpd session templates.

custom/cache.tcl
    # cache.tcl
    #
    #	Provide support for caching arbitrary content in tclhttpd
    #
    # CMcC 20040929 - Created

    package provide tclhttpd::cache 1.0

    # Cache module data
    #	suffix	the string suffix appended to a cache copy
    array set Cache {
        suffix _cache
    }

    # Cache_Fetch
    #	Check for the existence of a file ${path}_cache.
    #	if it exists, send it to client.
    #
    # Arguments:
    #	path	The file about to be processed
    #	bcache	Is the data cacheable in the browser?
    #
    # Results:
    #	Returns 1 if the cached version was sent, 0 otherwise
    #
    # Side Effects:
    #	Send the data down the socket

    proc Cache_Fetch {path {bcache 1}} {
        global Cache
        # handle cached generated files
        if {[file exists ${path}$Cache(suffix)]
    	&& ([file mtime $path] <= [file mtime ${path}$Cache(suffix)])} {
    	# file exists ... return it
    	set fd [open ${path}$Cache(suffix) r]
    	set ctype [gets $fd]	;# get the stored mime type
    	set content [read $fd]	;# get the generated content
    	close $fd

    	# return the file to the client socket
    	if {$bcache} {
    	    Httpd_ReturnCacheableData $sock $ctype $content [file mtime ${path}$Cache(suffix)]
    	} else {
    	    Httpd_ReturnData $sock $ctype $content
    	}

    	# indicate success
    	return 1
        }

        # there was no cache entry - indicate failure
        return 0
    }

    # Cache_Store
    #	Filter and store a file in ${path}$Cache(suffix)
    #	Send it to the client socket after running data(filters)
    #
    # Arguments:
    #	sock	The socket connection.
    #	path	The file system pathname of the file.
    #	content	The data to be returned to the client
    #	ctype	The mime content-type of content
    #	bcache	Is the data cacheable in the browser?
    #
    # Results:
    #	nothing
    #
    # Side Effects:
    #	data(filters) are run over content,
    #	a file ${path}$Cache(suffix) is created
    #	$content is returned to the client socket

    proc Cache_Store {sock path content ctype {bcache 1}} {
        global Cache
        upvar #0 Httpd$sock data

        catch {file delete -force ${path}$Cache(suffix)}

        # process filters now, so they'll be incorporated in cached version
        if {[info exists data(filter)]} {
    	while {[llength $data(filter)]} {
    	    set cmd [lindex $data(filter) end]
    	    set data(filter) [lrange $data(filter) 0 end-1]
    	    catch {
    		set content [eval $cmd $sock [list $content]]
    	    }
    	}
    	unset data(filter)	;# we've already filtered it - no more
        }

        if {[catch {open  ${path}$Cache(suffix) w} out eo]} {
    	Log $sock "stml" "no write permission"
        } else {
    	puts $out $ctype	;# record the mime type
    	puts -nonewline $out $content
    	close $out
        }

        # return the result - filters will be applied en route
        if {$bcache} {
    	Httpd_ReturnCacheableData $sock $ctype $content [clock scan now]]
        } else {
    	Httpd_ReturnData $sock $ctype $content
        }
    }

[Category TclHttpd]