This code implements a .stml file type, permitting per-session template expansion.
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.
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:
# Alternative to templating
# 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
array set Stml {
extension .stml
sextension .sstml
}
Mtype_Add $Stml(extension) application/x-tcl-session
Mtype_Add $Stml(sextension) application/x-tcl-safe-session
proc Doc_application/x-tcl-safe-session {path suffix sock {safe 1}} {
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
global Stml
# handle cached generated files
if {[file exists ${path}_cache] && ([file mtime $path] <= [file mtime ${path}_cache])} {
# file exists ... return it
set fd [open ${path}_cache r]
set ctype [gets $fd] ;# get the stored mime type
set html [read $fd] ;# get the generated content
close $fd
return [Httpd_ReturnData $sock $ctype $html]
}
# 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} html eo]
# Process the template itself
if {!$code} {
set code [catch {Subst_File $path $interp} html eo]
}
# Save return cookies, if any
Cookie_Save $sock $interp
Cookie_Save $sock
# process errors
if {$code} {
# delete the per-page session data
interp eval $interp $cleanup
# pass errors up - specifically Redirect return code
return -options $eo $html
}
# 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
}
# Cache the result
if {![interp eval $interp {set page(dynamic)}]} {
catch {file delete -force ${path}_cache}
# process any filters
set cache $html
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 cache [eval $cmd $sock [list $html]]
}
}
}
if {[catch {open ${path}_cache w} out eo]} {
Log $sock "stml" "no write permission"
} else {
puts $out $ctype ;# record the mime type
puts -nonewline $out $cache
close $out
}
}
# delete the per-page session data
interp eval $interp $cleanup
# return the result
return [Httpd_ReturnData $sock $ctype $html]
}Here's a test file: test.stml
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<!-- [package require html] -->
<html>
<head>
<title>Test session templates</title>
</head>
<body>
<h1>Test session templates</h1>
<h2>Session: [session]</h2>
<p>type: [value type]</p>
<p>interp:[value interp]</p>
<p>start: [value start]</p>
<p>current: [value current]</p>
<p>count: [value count]</p>
<p>[::html::tableFromArray data]</p>
<p>[::html::tableFromArray query]</p>
<p>[::html::tableFromArray page]</p>
<hr>
<address><a href="mailto:colin at sharedtech dot dyndns dot org">Colin McCormack</a></address>
<!-- Created: Thu Sep 16 08:53:25 EST 2004 -->
<!-- hhmts start -->
Last modified: Thu Sep 16 09:14:32 EST 2004
<!-- hhmts end -->
</body>
</html>