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