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]