This code implements a .stml file type, permitting per-session template expansion. [CMcC] 20040929
This facility now depends upon the [tclhttpd Generic Caching] module.
Note: there are some minor bugs in session.tcl in the released version of [tclhttpd] - to get the most out of this, you'd be well advised to get the HEAD from CVS. Also, it's written to tcl8.5, not 8.4 ... if you care, the backport is trivial.
Update:
Adopted [tclhttpd Generic Caching] code [CMcC] 20040929
----
Within a session template, you get a few built-in commands:
'''save''' - saves all variables and arrays within session
'''exit''' - utterly destroys the session and any persistent data
'''dynamic''' - makes this page's generation dynamic (default)
'''cache''' - causes this page to be cached.
'''value''' - get session variable value (values pertaining to session management)
'''group''' - get value pertaining to this session 'group'
'''session''' - get session id
'''sequence''' - get session sequence (for strictly sequenced sessions)
You also get some arrays (these don't persist):
'''data''' - per-socket data for this transaction
'''page''' - some page related data
'''query''' - query data encoded in URL
Additionally, any arrays or variables you create in the .stml code will persist if you have [[save]]d the session.
----
custom/stml.tcl:
# stml.tcl
#
# Per-session interpreter template substitution for tclhttpd
#
# CMcC 20040929 - Changed to make use of generic Cache module
DirList_IndexFile index.{stml,tml,html,shtml,thtml,htm,subst}
# Files with a .stml suffix or .sstml are templated and cached as with .tml files
# Template evaluation occurs within a cookie-session (a safe cookie session, for .ssmtl)
# Cookie session state can persist in file by calling Session_Save
Mtype_Add .stml application/x-tcl-session
Mtype_Add .sstml application/x-tcl-safe-session
proc Doc_application/x-tcl-safe-session {path suffix sock} {
return [Doc_application/x-tcl-session $path $suffix $sock 1]
}
proc Doc_application/x-tcl-session {path suffix sock {safe 0}} {
upvar #0 Httpd$sock data
# return a cached version, if possible
if {[Cache_Fetch $path]} {
return
}
# fetch query
array set query [list session new] ;# session id to create a new session
array set query [Url_DecodeQueryOnly $data(query)]
# decode session type from file names
# files like x.type.stml will create a session of type, default 'stml'
set type [string trimleft [file extension [file rootname $suffix]] .]
if {$type == ""} {
set type stml
}
# create or restore a cookie session
set session_error ""
set session [Session_Cookie [array get query session*] $type session_error $safe]
if {[string match Session:* $session_error]} {
# somehow our cookie and our session are out of whack
Session_Destroy $session ;# forget the session
Session_CookieDestroy $type ;# destroy the session cookies
Redirect_To $data(uri) ;# reload to get the new cookies
return ;# redundant - Redirect_To throws an error
}
set query(session) $session
# now we have a viable session with an interpreter
upvar #0 Session:$session state
set interp $state(interp)
if {[interp alias $interp exit] == ""} {
# create an 'exit' command
interp alias $interp exit {} Session_Destroy $session
}
if {[interp alias $interp save] == ""} {
# create a 'save' command
interp alias $interp save {} Session_Save $session
}
interp alias $interp cache $interp set page(dynamic) 0
interp alias $interp dynamic $interp set page(dynamic) 1
# generate interpreter script to source .tml files from the root downward.
global Template
set libs [Doc_GetPath $sock $path]
foreach libdir $libs {
set libfile [file join $libdir $Template(tmlExt)]
if {[file exists $libfile]} {
append "script source $libfile" \n
}
}
# generate interpreter initialization script
append script [subst {
catch {unset page}
catch {unset query}
catch {unset data}
array set page {
url $data(url)
dynamic 1
directory [file join {expand}$libs]
}
array set query [list [array get query]]
array set data [list [array get data]]
}]
set cleanup {
catch {unset page}
catch {unset query}
catch {unset data}
}
# initialize the interpreter
set code [catch {interp eval $interp $script} content eo]
# Process the template itself
if {!$code} {
set code [catch {Subst_File $path $interp} content eo]
}
# Save return cookies, if any
Cookie_Save $sock
# process errors now
if {$code} {
# delete the per-page session data
interp eval $interp $cleanup
# pass errors up - specifically Redirect return code
return -options $eo $content
}
# calculate mime type of return
if {[interp eval $interp {info exists data(contentType)}]} {
set ctype [interp eval $interp {set data(contentType)}] ;# set by a template
} else {
set ctype text/html
}
# delete the per-page session data
interp eval $interp $cleanup
# Cache the result
if {![interp eval $interp {set page(dynamic)}]} {
# this page is cacheable
Cache_Store $sock $path $content $ctype
} else {
# return the result - filters will be applied en route
return [Httpd_ReturnData $sock $ctype $content]
}
}
----
Here's a test file: test.stml
Test session templates
Test session templates
Session: [session]
type: [value type]
interp:[value interp]
start: [value start]
current: [value current]
count: [value count]
[::html::tableFromArray data]
[::html::tableFromArray query]
[::html::tableFromArray page]
Colin McCormack
Last modified: Thu Sep 16 09:14:32 EST 2004
----
[[[Category TclHttpd]]]