Updated 2013-12-01 02:36:12 by AMG

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.

# 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]} {

    # 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 {*}$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
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<!-- [package require html] -->
    <title>Test session templates</title>

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

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

Colin, I NB could not get this test page to work, using a tclkit85a4, and tclhttpd from cvs. I loaded generic caching and stml w/o errors. When I tried the above example, in the root of my site, I got errors about not finding mypage, faq etc. I removed these from the main .tml file and got a error 'bout not finding the html package...Seems that the slave interp is not aware of the packages that the main interp uses ...Maybe?