Updated 2004-11-20 12:34:29 by CMCc

This is a fusion of tclhttpd Direct and Doc domains

It will try to find a match using the same technique as Doc, and fall back to a Direct domain if it can't. Additionally, the ${prefix}/* proc will be called on no match.

You will need today's CVS HEAD at least, but newer is always better. See tclhttpd for how to get tar and zip snapshots.

Enjoy! -- CMcC 20041120

To create an Indirect domain you call [Indirect::Url virtual directory prefix] where virtual is the URL path to this domain, directory is the file directory for templates and prefix is a prefix to be prepended to the command invocation.

This domain would be useful for applications which operate on directories and files - one could, for example, create a [search] process which searched the files in a directory, one could use the /* function to create new files on demand, as in Wikit.

prefix can be a simple string, an alias, a namespace prefix or an interp eval prefix.
    package require httpd::direct

    namespace eval Indirect {
        variable Indirect

    proc Indirect::Url {virtual directory {prefix {}} {inThread 0}} {
        variable Indirect
        if {[string length $prefix] == 0} {
    	set prefix $virtual
        set Indirect($prefix) $virtual	;# So we can reconstruct URLs
        Doc_RegisterRoot $virtual $directory
        Url_PrefixInstall $virtual [list Indirect::domain $prefix $directory] $inThread

    proc Indirect::UrlRemove {prefix} {
        variable Indirect
        catch { Url_PrefixRemove $Indirect($prefix) }
        catch { unset Indirect($prefix) }

    proc Indirect::domain {prefix directory sock suffix} {
        variable Indirect
        upvar #0 Httpd$sock data

        # Prepare argument data from the query data.
        Url_QuerySetup $sock

        set path [file join $directory [string trimleft $suffix /~]]
        set path [file normalize $path]
        set data(path) $path	;# record this path for not found handling
        set data(directory) $directory

        # Look for a fresh template which generates the desired path
        if {[Template_Try $sock $path $prefix $suffix]} {
    	# template has handled the request
    	return 1

        # Template_Try hasn't satisfied the request,
        # Look for an exact match.
        if {[file exists $path] && [file readable $path]} {
    	# we have a file precisely matching the request
    	Doc_Return $prefix $path $suffix $sock
    	return 1

        # no matching file - try a direct call
        set cmd [Direct_MarshallArguments $prefix $suffix]

        if {$cmd == ""} {
    	# Negotiate an Acceptable available alternative file
    	# if one is found, a redirect is provoked
    	# (FIXME: is this according to the spec?)
    	if {[Fallback_Try $prefix $path $suffix $sock]} {
    	    # we have found an Accept-able alternative
    	    # Fallback_Try generates a redirect
    	    return 1

    	# still no match - try the * command
    	set cmd [Direct_MarshallArguments $prefix /*]
    	if {$cmd == ""} {
    	    Doc_NotFound $sock

        # Eval the command.  Errors can be used to trigger redirects.
        set code [catch $cmd result]

        set type text/html
        upvar #0 $prefix$suffix aType
        if {[info exist aType]} {
    	set type $aType

        Direct_Respond $sock $code $result $type

Example indirect domain
    Indirect::Url /indirect indirect_test ::indirect::

    namespace eval indirect {
        proc /moop {args} {
    	return "<html><head><title>Moop</title></head><body>$args</body></html>"

        proc /* {args} {
    	upvar #0 Httpd[Httpd_CurrentSocket] data
    	return "<html><head><title>Moop</title></head><body><h3>Not Found</h3><p>[array get data]</p></body></html>"

[Category TclHttpd]