tclhttpd Generic Caching

Difference between version 2 and 3 - Previous - Next
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
        }
    }----
[[[C<<categoryies>> Caching | TclHttpd]]]