This code implements a .stml file type, permitting per-session template expansion.
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>