tclhttpd Generic Caching

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
        }
    }