You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by mx...@apache.org on 2011/03/04 00:51:03 UTC
svn commit: r1076894 [2/2] - in /tcl/rivet/branches/rivet-namespace: ./ doc/
doc/examples/ doc/xml/ rivet/rivet-tcl/ src/ src/apache-2/
Modified: tcl/rivet/branches/rivet-namespace/doc/xml/directives.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/doc/xml/directives.xml?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/doc/xml/directives.xml (original)
+++ tcl/rivet/branches/rivet-namespace/doc/xml/directives.xml Thu Mar 3 23:51:02 2011
@@ -15,14 +15,17 @@
role since the script runs within the master interpreter,
an interpreter created before the Apache parent process spawns
the children that actually will serve the requests coming from
- the network. During this
- stage Apache is still running as a single process, so this
- is the right place for doing initializations or loading packages
- that have be common to all the interpreters that are to be created
+ the network. During this stage Apache is still running as a
+ single process, so this is the right place for doing
+ initializations or loading packages
+ that have be common to all the interpreters that will be created
when Apache forks its child processes, even when the option
- <command>SeparateVirtualInterps</command> is set. The
- <command>ServerInitScript</command> is also the right place for
- doing the creation and initialization of a IPC system.
+ <command>SeparateVirtualInterps</command> is set. Since this
+ script will be running in a single process environment (from the
+ Apache point of view) <command>ServerInitScript</command>
+ is also the right place for doing everything that must avoid
+ resource concurrency among processes (e.g. the creation and
+ initialization of an IPC system)
</para>
</section>
<section>
@@ -32,20 +35,22 @@
<cmdsynopsis>
<command>RivetServerConf</command>
<group choice="req">
- <arg>CacheSize</arg>
- <arg>ServerInitScript</arg>
- <arg>GlobalInitScript</arg>
- <arg>ChildInitScript</arg>
- <arg>ChildExitScript</arg>
- <arg>BeforeScript</arg>
- <arg>AfterScript</arg>
- <arg>ErrorScript</arg>
- <arg>UploadDirectory</arg>
- <arg>UploadMaxSize</arg>
- <arg>UploadFilesToVar</arg>
- <arg>SeparateVirtualInterps</arg>
- <arg>HonorHeaderOnlyRequests</arg>
- </group>
+ <arg>CacheSize</arg>
+ <arg>ServerInitScript</arg>
+ <arg>GlobalInitScript</arg>
+ <arg>ChildInitScript</arg>
+ <arg>ChildExitScript</arg>
+ <arg>BeforeScript</arg>
+ <arg>AfterScript</arg>
+ <arg>ErrorScript</arg>
+ <arg>AbortScript</arg>
+ <arg>AfterEveryScript</arg>
+ <arg>UploadDirectory</arg>
+ <arg>UploadMaxSize</arg>
+ <arg>UploadFilesToVar</arg>
+ <arg>SeparateVirtualInterps</arg>
+ <arg>HonorHeaderOnlyRequests</arg>
+ </group>
</cmdsynopsis>
</term>
<listitem>
@@ -218,45 +223,87 @@
<varlistentry>
<term>
- <cmdsynopsis>
- <arg choice="plain">ErrorScript</arg>
- <arg><replaceable>script</replaceable></arg>
- </cmdsynopsis>
+ <cmdsynopsis>
+ <arg choice="plain">ErrorScript</arg>
+ <arg><replaceable>script</replaceable></arg>
+ </cmdsynopsis>
</term>
<listitem>
- <para>
- When Rivet encounters an error in a script, it
- constructs an HTML page with some information about
- the error, and the script that was being
- evaluated. If an <option>ErrorScript</option> is
- specified, it is possible to create custom error
- pages. This may be useful if you want to make sure
- that users never view your source code.
- </para>
- <para>
- In virtual hosts, this option takes precedence over
- the global setting.
- </para>
+ <para>
+ When Rivet encounters an error in a script, it
+ constructs an HTML page with some information about
+ the error, and the script that was being
+ evaluated. If an <option>ErrorScript</option> is
+ specified, it is possible to create custom error
+ pages. This may be useful if you want to make sure
+ that users never view your source code.
+ </para>
+ <para>
+ In virtual hosts, this option takes precedence over
+ the global setting.
+ </para>
</listitem>
</varlistentry>
<varlistentry>
<term>
- <cmdsynopsis>
- <arg choice="plain">UploadDirectory</arg>
- <arg><replaceable>directory</replaceable></arg>
- </cmdsynopsis>
+ <cmdsynopsis>
+ <arg choice="plain">AfterEveryScript</arg>
+ <arg><replaceable>script</replaceable></arg>
+ </cmdsynopsis>
</term>
<listitem>
- <para>Directory to place uploaded files.</para>
- <para>
- In virtual hosts, this option takes precedence over
- the global setting.
- </para>
+ <para>
+ <option>AfterEveryScript</option> is a script that is to
+ be run anyway before requests processing ends. This script
+ is therefore run both when the content generation script
+ completes successfully and when its execution is interrupted
+ by <xref linkend="abort_page" />. The code in this script
+ can understand whether it's running after the page was
+ interrupted by calling <xref linkend="abort_page" />
+ with the argument <arg>-aborting</arg>. The command
+ will return 1 if an abort_page call took place
+ earlier in the request processing.
+ </para>
</listitem>
</varlistentry>
- <varlistentry>
+ <varlistentry>
+ <term>
+ <cmdsynopsis>
+ <arg choice="plain">AbortScript</arg>
+ <arg><replaceable>script</replaceable></arg>
+ </cmdsynopsis>
+ </term>
+ <listitem>
+ <para>
+ The execution of a can be interrupted by
+ invoking <xref linkend="abort_page" />. If
+ an <option>AbortScript</option> is defined for the page
+ being generated, control is passed to it. <option>AbortScript</option>
+ is the right place where specific actions can be taken
+ to catch resources left dangling by the sudden interruption.
+ </para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
+ <term>
+ <cmdsynopsis>
+ <arg choice="plain">UploadDirectory</arg>
+ <arg><replaceable>directory</replaceable></arg>
+ </cmdsynopsis>
+ </term>
+ <listitem>
+ <para>Directory to place uploaded files.</para>
+ <para>
+ In virtual hosts, this option takes precedence over
+ the global setting.
+ </para>
+ </listitem>
+ </varlistentry>
+
+ <varlistentry>
<term>
<cmdsynopsis>
<arg choice="plain">UploadMaxSize</arg>
Modified: tcl/rivet/branches/rivet-namespace/doc/xml/examples.xml
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/doc/xml/examples.xml?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/doc/xml/examples.xml (original)
+++ tcl/rivet/branches/rivet-namespace/doc/xml/examples.xml Thu Mar 3 23:51:02 2011
@@ -11,57 +11,57 @@
<example id="hello world">
<title>Hello World</title>
<para>
- As with any tool, it's always nice to see something work, so
- let's create a small "Hello World" page.</para>
- <para>
- Assuming you have Apache configured correctly, create a file
- called <filename>hello.rvt</filename> where Apache can find
- it, with the following content:
+ As with any tool, it's always nice to see something work, so
+ let's create a small "Hello World" page.
+ </para>
+ <para>
+ Assuming you have Apache configured correctly, create a file
+ called <filename>hello.rvt</filename> where Apache can find
+ it, with the following content:
</para>
<programlisting>&hello.rvt;</programlisting>
<para>
- If you then access it with your browser, you should see a
- blank page with the text "Hello World" (without the quotes) on it.
+ If you then access it with your browser, you should see a
+ blank page with the text "Hello World" (without the quotes) on it.
</para>
</example>
<example>
- <title>Generate a Table</title>
- <para>
- In another simple example, we dynamically generate a table:
- </para>
- <programlisting>&table.rvt;</programlisting>
- <para>
- If you read the code, you can see that this is pure Tcl. We
- could take the same code, run it outside of Rivet, and it
- would generate the same HTML!
- </para>
- <para>
- The result should look something like this:
- </para>
- <graphic fileref="images/table.png"/>
-
+ <title>Generate a Table</title>
+ <para>
+ In another simple example, we dynamically generate a table:
+ </para>
+ <programlisting>&table.rvt;</programlisting>
+ <para>
+ If you read the code, you can see that this is pure Tcl. We
+ could take the same code, run it outside of Rivet, and it
+ would generate the same HTML!
+ </para>
+ <para>
+ The result should look something like this:
+ </para>
+ <graphic fileref="images/table.png"/>
</example>
<example id="variable_access">
<title>Variable Access</title>
<para>
- Here, we demonstrate how to access variables set by GET or
- POST operations.
+ Here, we demonstrate how to access variables set by GET or
+ POST operations.
</para>
<para>
- Given an HTML form like the following:
+ Given an HTML form like the following:
</para>
<programlisting>&vars.html;</programlisting>
<para>
- We can use this Rivet script to get the variable values:
+ We can use this Rivet script to get the variable values:
</para>
<programlisting>&vars.rvt;</programlisting>
<para>
- The first statement checks to make sure that the
- <varname>boss</varname> variable has been passed to the
- script, and then does something with that information. If
- it's not present, an error is added to the list of errors.
+ The first statement checks to make sure that the
+ <varname>boss</varname> variable has been passed to the
+ script, and then does something with that information. If
+ it's not present, an error is added to the list of errors.
</para>
<para>
In the second block of code, the variable
@@ -87,74 +87,74 @@
of errors it contains is printed.
</para>
</example>
-
+
<example id="file_upload">
<title>File Upload</title>
<para>
- The <command>upload</command> command endows Rivet with an
- interface to access files transferred over http as parts of a
- multipart form. The following HTML in one file, say,
- <filename>upload.html</filename> creates a form with a text
- input entry. By clicking the file chooser button the file
- browser shows up and the user selects the file to be uploaded
- (the file path will appear in the text input). In order to make
- sure you're uploading the whole file you must combine the
- action of the enctype and method attributes of the
- <form...> tag in the way shown in the example. Failure
- to do so would result in the client sending only the file's
- path, rather than the actual contents.
+ The <command>::rivet::upload</command> command endows Rivet with an
+ interface to access files transferred over http as parts of a
+ multipart form. The following HTML in one file, say,
+ <filename>upload.html</filename> creates a form with a text
+ input entry. By clicking the file chooser button the file
+ browser shows up and the user selects the file to be uploaded
+ (the file path will appear in the text input). In order to make
+ sure you're uploading the whole file you must combine the
+ action of the enctype and method attributes of the
+ <form...> tag in the way shown in the example. Failure
+ to do so would result in the client sending only the file's
+ path, rather than the actual contents.
</para>
<programlisting>&upload.html;</programlisting>
<para>
- In the script invoked by the form
- (<filename>upload.rvt</filename>) <command>upload</command>
- <arg>argument ...</arg> commands can be used to manipulate the
- various files uploaded.
+ In the script invoked by the form
+ (<filename>upload.rvt</filename>) <command>upload</command>
+ <arg>argument ...</arg> commands can be used to manipulate the
+ various files uploaded.
</para>
<programlisting>&upload.rvt;</programlisting>
<para>
- Don't forget that the apache server must have write access to
- the directory where files are being created. The Rivet Apache
- directives have a substantial impact on the upload process,
- you have to carefully read the docs in order to set the
- appropriate directives values that would match your
- requirements.
- </para>
- <para>
- It is also important to understand that some
- <command>upload</command> commands are effective only when
- used in a mutually exclusive way. Apache stores the data in
- temporary files which are read by the <command>upload save
- <arg>upload name</arg><arg>filename</arg></command> or by the
- <command>upload data <arg>upload name</arg></command>
- command. Subsequent calls to these 2 commands using the same
- <arg>upload name</arg> argument will return no data on the
- second call. Likewise <command>upload channel <arg>upload
- name</arg></command> will return a Tcl file channel that you
- can use in regular Tcl scripts only if you haven't already
- read the data, for example with a call to the <command>upload
- data <arg>upload name</arg></command> command.
+ Don't forget that the apache server must have write access to
+ the directory where files are being created. The Rivet Apache
+ directives have a substantial impact on the upload process,
+ you have to carefully read the docs in order to set the
+ appropriate directives values that would match your
+ requirements.
+ </para>
+ <para>
+ It is also important to understand that some
+ <command>upload</command> commands are effective only when
+ used in a mutually exclusive way. Apache stores the data in
+ temporary files which are read by the <command>upload save
+ <arg>upload name</arg><arg>filename</arg></command> or by the
+ <command>upload data <arg>upload name</arg></command>
+ command. Subsequent calls to these 2 commands using the same
+ <arg>upload name</arg> argument will return no data on the
+ second call. Likewise <command>upload channel <arg>upload
+ name</arg></command> will return a Tcl file channel that you
+ can use in regular Tcl scripts only if you haven't already
+ read the data, for example with a call to the <command>upload
+ data <arg>upload name</arg></command> command.
</para>
</example>
<example id="file_download">
<title>File Download</title>
<para>
- In general setting up a data file for being sent over http is
- as easy as determining the file's URI and letting Apache's
- do all that is needed. If this approach fits your design all
- you have to do is to keep the downloadable files somewhere
- within Apache's DocumentRoot (or in any of the directories
- Apache has right to access).
- </para>
- <para>
- When a client sends a request for a file, Apache takes
- care of determining the filetype, sends appropriate headers to
- the client and then the file content. The client is responsible
- for deciding how to handle the data accordingly to the
- "content-type" headers and its internal design. For example
- when browsers give up trying to display a certain "content-type"
- they display a download dialog box asking for directions from
- the user.
+ In general setting up a data file for being sent over http is
+ as easy as determining the file's URI and letting Apache's
+ do all that is needed. If this approach fits your design all
+ you have to do is to keep the downloadable files somewhere
+ within Apache's DocumentRoot (or in any of the directories
+ Apache has right to access).
+ </para>
+ <para>
+ When a client sends a request for a file, Apache takes
+ care of determining the filetype, sends appropriate headers to
+ the client and then the file content. The client is responsible
+ for deciding how to handle the data accordingly to the
+ "content-type" headers and its internal design. For example
+ when browsers give up trying to display a certain "content-type"
+ they display a download dialog box asking for directions from
+ the user.
</para>
<para>
Rivet can help if you have more sofisticated needs. For
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/cookie.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/cookie.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/cookie.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/cookie.tcl Thu Mar 3 23:51:02 2011
@@ -4,13 +4,16 @@
## $Id$
##
+
+namespace ::rivet {
+
## clock_to_rfc850_gmt seconds -- Convert an integer-seconds-since-1970
## click value to RFC850 format, with the additional requirement that it
## be GMT only.
##
-proc clock_to_rfc850_gmt {seconds} {
- return [clock format $seconds -format "%a, %d-%b-%y %T GMT" -gmt 1]
-}
+ proc clock_to_rfc850_gmt {seconds} {
+ return [clock format $seconds -format "%a, %d-%b-%y %T GMT" -gmt 1]
+ }
## make_cookie_attributes paramsArray -- Build up cookie parameters.
##
@@ -27,37 +30,38 @@ proc clock_to_rfc850_gmt {seconds} {
##
## The resut is returned.
##
-proc make_cookie_attributes {paramsArray} {
- upvar 1 $paramsArray params
- set cookieParams ""
- set expiresIn 0
+ proc make_cookie_attributes {paramsArray} {
+ upvar 1 $paramsArray params
- if { [info exists params(expires)] } {
- append cookieParams "; expires=$params(expires)"
- } else {
- foreach {time num} [list days 86400 hours 3600 minutes 60] {
- if [info exists params($time)] {
- incr expiresIn [expr $params($time) * $num]
- }
- }
- if {$expiresIn != 0} {
- set secs [expr [clock seconds] + $expiresIn]
- append cookieParams "; expires=[clock_to_rfc850_gmt $secs]"
- }
- }
- if { [info exists params(path)] } {
- append cookieParams "; path=$params(path)"
- }
- if { [info exists params(domain)] } {
- append cookieParams "; domain=$params(domain)"
- }
- if { [info exists params(secure)] && $params(secure) == 1} {
- append cookieParams "; secure"
- }
+ set cookieParams ""
+ set expiresIn 0
- return $cookieParams
-}
+ if { [info exists params(expires)] } {
+ append cookieParams "; expires=$params(expires)"
+ } else {
+ foreach {time num} [list days 86400 hours 3600 minutes 60] {
+ if [info exists params($time)] {
+ incr expiresIn [expr $params($time) * $num]
+ }
+ }
+ if {$expiresIn != 0} {
+ set secs [expr [clock seconds] + $expiresIn]
+ append cookieParams "; expires=[clock_to_rfc850_gmt $secs]"
+ }
+ }
+ if { [info exists params(path)] } {
+ append cookieParams "; path=$params(path)"
+ }
+ if { [info exists params(domain)] } {
+ append cookieParams "; domain=$params(domain)"
+ }
+ if { [info exists params(secure)] && $params(secure) == 1} {
+ append cookieParams "; secure"
+ }
+
+ return $cookieParams
+ }
## cookie [set|get] cookieName ?cookieValue? [-days expireInDays]
## [-hours expireInHours] [-minutes expireInMinutes]
@@ -65,50 +69,53 @@ proc make_cookie_attributes {paramsArray
## [-path uriPathCookieAppliesTo]
## [-secure 1|0]
##
-proc cookie {cmd name args} {
- set badchars "\[ \t;\]"
- switch -- $cmd {
- "set" {
- set value [lindex $args 0]
- set args [lrange $args 1 end]
- import_keyvalue_pairs params $args
-
- if {[regexp $badchars $name]} {
- return -code error \
- "name may not contain semicolons, spaces, or tabs"
- }
- if {[regexp $badchars $value]} {
- return -code error \
- "value may not contain semicolons, spaces, or tabs"
- }
-
- set cookieKey "Set-Cookie"
- set cookieValue "$name=$value"
-
- append cookieValue [make_cookie_attributes params]
-
- headers add $cookieKey $cookieValue
- }
-
- "get" {
- ::request::global RivetCookies
-
- if {![array exists RivetCookies]} { load_cookies RivetCookies }
- if {![info exists RivetCookies($name)]} { return }
- return $RivetCookies($name)
- }
-
- "delete" {
- ## In order to delete a cookie, we just need to set a cookie
- ## with a time that has already expired.
- cookie set $name "" -minutes -1
- }
- "unset" {
- ::request::global RivetCookies
- if {![array exists RivetCookies]} { load_cookies RivetCookies }
- if {![info exists RivetCookies($name)]} { return }
- unset RivetCookies($name)
- }
+ proc cookie {cmd name args} {
+ set badchars "\[ \t;\]"
+
+ switch -- $cmd {
+ "set" {
+ set value [lindex $args 0]
+ set args [lrange $args 1 end]
+ import_keyvalue_pairs params $args
+
+ if {[regexp $badchars $name]} {
+ return -code error \
+ "name may not contain semicolons, spaces, or tabs"
+ }
+ if {[regexp $badchars $value]} {
+ return -code error \
+ "value may not contain semicolons, spaces, or tabs"
+ }
+
+ set cookieKey "Set-Cookie"
+ set cookieValue "$name=$value"
+
+ append cookieValue [make_cookie_attributes params]
+
+ headers add $cookieKey $cookieValue
+ }
+
+ "get" {
+ ::request::global RivetCookies
+
+ if {![array exists RivetCookies]} { load_cookies RivetCookies }
+ if {![info exists RivetCookies($name)]} { return }
+ return $RivetCookies($name)
+ }
+
+ "delete" {
+ ## In order to delete a cookie, we just need to set a cookie
+ ## with a time that has already expired.
+ cookie set $name "" -minutes -1
+ }
+ "unset" {
+ ::request::global RivetCookies
+ if {![array exists RivetCookies]} { load_cookies RivetCookies }
+ if {![info exists RivetCookies($name)]} { return }
+ unset RivetCookies($name)
+ }
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/debug.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/debug.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/debug.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/debug.tcl Thu Mar 3 23:51:02 2011
@@ -11,6 +11,7 @@
## it at the global level.
##
## Options:
+##
## -subst <on|off> - Each word should be considered a variable and subst'd.
## -separator <string> - A text string that goes between each variable.
## -ip <ip address> - A list of IP addresses to display to.
@@ -19,70 +20,73 @@
##
###
-proc debug {args} {
- ## If they've turned off debugging, we don't do anything.
- if {[info exists ::RivetUserConf(Debug)] && !$::RivetUserConf(Debug)} {
- return
- }
-
- ## We want to save the REMOTE_ADDR for any subsequent calls to debug.
- if {![info exists ::RivetUserConf(REMOTE_ADDR)]} {
- set REMOTE_ADDR [env REMOTE_ADDR]
- set ::RivetUserConf(REMOTE_ADDR) $REMOTE_ADDR
- }
-
-
- ## Set some defaults for the options.
- set data(subst) 0
- set data(separator) <br>
-
- ## Check RivetUserConf for globally set options.
- if {[info exists ::RivetUserConf(DebugIp)]} {
- set data(ip) $::RivetUserConf(DebugIp)
- }
- if {[info exists ::RivetUserConf(DebugSubst)]} {
- set data(subst) $::RivetUserConf(DebugSubst)
- }
- if {[info exists ::RivetUserConf(DebugSeparator)]} {
- set data(separator) $::RivetUserConf(DebugSeparator)
- }
-
- import_keyvalue_pairs data $args
-
- if {[info exists data(ip)]} {
- set can_see 0
- foreach ip $data(ip) {
- if {[string match $data(ip)* $::RivetUserConf(REMOTE_ADDR)]} {
- set can_see 1
- break
- }
- }
- if {!$can_see} { return }
- }
-
- if {[string tolower $data(subst)] != "on"} {
- html [join $data(args)]
- return
- }
+namespace eval ::rivet {
- set lastWasArray 0
- foreach varName $data(args) {
- upvar $varName var
- if {[array exists var]} {
- parray $varName
- set lastWasArray 1
- } elseif {[info exists var]} {
- if {!$lastWasArray} {
- html $data(separator)
- }
- html $var
- set lastWasArray 0
- } else {
- if {!$lastWasArray} {
- html $data(separator)
- }
- html $varName
- set lastWasArray 0
- }
+ proc debug {args} {
+ ## If they've turned off debugging, we don't do anything.
+ if {[info exists ::RivetUserConf(Debug)] && !$::RivetUserConf(Debug)} {
+ return
+ }
+
+ ## We want to save the REMOTE_ADDR for any subsequent calls to debug.
+ if {![info exists ::RivetUserConf(REMOTE_ADDR)]} {
+ set REMOTE_ADDR [env REMOTE_ADDR]
+ set ::RivetUserConf(REMOTE_ADDR) $REMOTE_ADDR
+ }
+
+
+ ## Set some defaults for the options.
+ set data(subst) 0
+ set data(separator) <br>
+
+ ## Check RivetUserConf for globally set options.
+ if {[info exists ::RivetUserConf(DebugIp)]} {
+ set data(ip) $::RivetUserConf(DebugIp)
+ }
+ if {[info exists ::RivetUserConf(DebugSubst)]} {
+ set data(subst) $::RivetUserConf(DebugSubst)
+ }
+ if {[info exists ::RivetUserConf(DebugSeparator)]} {
+ set data(separator) $::RivetUserConf(DebugSeparator)
+ }
+
+ import_keyvalue_pairs data $args
+
+ if {[info exists data(ip)]} {
+ set can_see 0
+ foreach ip $data(ip) {
+ if {[string match $data(ip)* $::RivetUserConf(REMOTE_ADDR)]} {
+ set can_see 1
+ break
+ }
+ }
+ if {!$can_see} { return }
+ }
+
+ if {[string tolower $data(subst)] != "on"} {
+ html [join $data(args)]
+ return
+ }
+
+ set lastWasArray 0
+ foreach varName $data(args) {
+ upvar $varName var
+ if {[array exists var]} {
+ parray $varName
+ set lastWasArray 1
+ } elseif {[info exists var]} {
+ if {!$lastWasArray} {
+ html $data(separator)
+ }
+ html $var
+ set lastWasArray 0
+ } else {
+ if {!$lastWasArray} {
+ html $data(separator)
+ }
+ html $varName
+ set lastWasArray 0
+ }
+ }
}
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/html.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/html.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/html.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/html.tcl Thu Mar 3 23:51:02 2011
@@ -14,11 +14,15 @@
##
###
-proc html {string args} {
- foreach arg $args { append output <$arg> }
- append output $string
- for {set i [expr [llength $args] - 1]} {$i >= 0} {incr i -1} {
- append output </[lindex [lindex $args $i] 0]>
+namespace eval ::rivet {
+
+ proc html {string args} {
+ foreach arg $args { append output <$arg> }
+ append output $string
+ for {set i [expr [llength $args] - 1]} {$i >= 0} {incr i -1} {
+ append output </[lindex [lindex $args $i] 0]>
+ }
+ puts $output
}
- puts $output
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_keyvalue_pairs.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_keyvalue_pairs.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_keyvalue_pairs.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_keyvalue_pairs.tcl Thu Mar 3 23:51:02 2011
@@ -10,43 +10,48 @@
## $Id$
##
###
-proc import_keyvalue_pairs {arrayName argsList} {
- upvar 1 $arrayName data
- # if the first character of the arg list isn't a dash, put the whole
- # body in the args element of the array, and we're done
+namespace eval ::rivet {
- if {[string index $argsList 0] != "-"} {
- set data(args) $argsList
- return
- }
+ proc import_keyvalue_pairs {arrayName argsList} {
+ upvar 1 $arrayName data
+
+ # if the first character of the arg list isn't a dash, put the whole
+ # body in the args element of the array, and we're done
- set index 0
- set looking 0
- set data(args) ""
-
- foreach arg $argsList {
- if {$looking} {
- set data($varName) $arg
- set looking 0
- } elseif {[string index $arg 0] == "-"} {
-
- if {$arg == "--"} {
- # "--" appears as an argument, store the reset of the arg list
- # in the args element of the array
- set data(args) [lrange $argsList [expr $index + 1] end]
- break
- }
-
- if {$arg == "-args"} {
- return -code error "-args is a reserved value."
- }
- set varName [string range $arg 1 end]
- set looking 1
- } else {
- set data(args) [lrange $argsList $index end]
- break
- }
- incr index
+ if {[string index $argsList 0] != "-"} {
+ set data(args) $argsList
+ return
+ }
+
+ set index 0
+ set looking 0
+ set data(args) ""
+
+ foreach arg $argsList {
+ if {$looking} {
+ set data($varName) $arg
+ set looking 0
+ } elseif {[string index $arg 0] == "-"} {
+
+ if {$arg == "--"} {
+ # "--" appears as an argument, store the rest of the arg list
+ # in the args element of the array
+ set data(args) [lrange $argsList [expr $index + 1] end]
+ break
+ }
+
+ if {$arg == "-args"} {
+ return -code error "-args is a reserved value."
+ }
+ set varName [string range $arg 1 end]
+ set looking 1
+ } else {
+ set data(args) [lrange $argsList $index end]
+ break
+ }
+ incr index
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_switch_args.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_switch_args.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_switch_args.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/import_switch_args.tcl Thu Mar 3 23:51:02 2011
@@ -8,29 +8,36 @@
## $Id$
##
###
-proc import_switch_args {arrayName argsList {switchList ""}} {
- upvar 1 $arrayName array
- set index 0
- set array(args) ""
- set array(switches) ""
- if {[llength $switchList] > 0} {
- set proofSwitches 1
- } else {
- set proofSwitches 0
- }
- foreach arg $argsList {
- if {[string index $args 0] != "-"} {
- set array(args) [lrange $argsList $index end]
- break
- } elseif {$arg == "--"} {
- set array(args) [lrange $argsList [expr $index + 1] end]
- break
- }
- set switch [string range $arg 1 end]
- if {!$proofSwitches || [lsearch -exact $switchList $switch] >= 0} {
- set array($switch) $index
- lappend array(switches) $switch
- }
- incr index
+
+namespace ::rivet {
+
+ proc import_switch_args {arrayName argsList {switchList ""}} {
+ upvar 1 $arrayName array
+ set index 0
+ set array(args) ""
+ set array(switches) ""
+ if {[llength $switchList] > 0} {
+ set proofSwitches 1
+ } else {
+ set proofSwitches 0
+ }
+
+ foreach arg $argsList {
+ if {[string index $args 0] != "-"} {
+ set array(args) [lrange $argsList $index end]
+ break
+ } elseif {$arg == "--"} {
+ set array(args) [lrange $argsList [expr $index + 1] end]
+ break
+ }
+
+ set switch [string range $arg 1 end]
+ if {!$proofSwitches || [lsearch -exact $switchList $switch] >= 0} {
+ set array($switch) $index
+ lappend array(switches) $switch
+ }
+ incr index
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lassign.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lassign.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lassign.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lassign.tcl Thu Mar 3 23:51:02 2011
@@ -8,9 +8,13 @@
##
###
-proc lassign {list args} {
- foreach elem $list varName $args {
- upvar 1 $varName var
- set var $elem
+namespace eval ::rivet {
+
+ proc lassign {list args} {
+ foreach elem $list varName $args {
+ upvar 1 $varName var
+ set var $elem
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lempty.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lempty.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lempty.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lempty.tcl Thu Mar 3 23:51:02 2011
@@ -8,7 +8,11 @@
##
###
-proc lempty {list} {
- if {[catch {llength $list} len]} { return 0 }
- return [expr $len == 0]
+namespace eval ::rivet {
+
+ proc lempty {list} {
+ if {[catch {llength $list} len]} { return 0 }
+ return [expr $len == 0]
+ }
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lmatch.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lmatch.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lmatch.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/lmatch.tcl Thu Mar 3 23:51:02 2011
@@ -13,38 +13,40 @@
##
###
-proc lmatch {args} {
- set modes(-exact) 0
- set modes(-glob) 1
- set modes(-regexp) 2
+namespace eval ::rivet {
+ proc lmatch {args} {
+ set modes(-exact) 0
+ set modes(-glob) 1
+ set modes(-regexp) 2
- if {[llength $args] == 3} {
- lassign $args mode list pattern
- } elseif {[llength $args] == 2} {
- set mode -glob
- lassign $args list pattern
- } else {
- return -code error \
- {wrong # args: should be "lmatch ?mode? list pattern"}
- }
+ if {[llength $args] == 3} {
+ lassign $args mode list pattern
+ } elseif {[llength $args] == 2} {
+ set mode -glob
+ lassign $args list pattern
+ } else {
+ return -code error \
+ {wrong # args: should be "lmatch ?mode? list pattern"}
+ }
- if {![info exists modes($mode)]} {
- return -code error \
- "bad search mode \"$mode\": must be -exact, -glob, or -regexp"
- }
- set mode $modes($mode)
+ if {![info exists modes($mode)]} {
+ return -code error \
+ "bad search mode \"$mode\": must be -exact, -glob, or -regexp"
+ }
+ set mode $modes($mode)
- set return {}
- foreach elem $list {
- if {$mode == 0} {
- if {[string compare $elem $pattern] == 0} { lappend return $elem }
- }
- if {$mode == 1} {
- if {[string match $pattern $elem]} { lappend return $elem }
- }
- if {$mode == 2} {
- if {[regexp $pattern $elem]} { lappend return $elem }
- }
+ set return {}
+ foreach elem $list {
+ if {$mode == 0} {
+ if {[string compare $elem $pattern] == 0} { lappend return $elem }
+ }
+ if {$mode == 1} {
+ if {[string match $pattern $elem]} { lappend return $elem }
+ }
+ if {$mode == 2} {
+ if {[regexp $pattern $elem]} { lappend return $elem }
+ }
+ }
+ return $return
}
- return $return
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_cookies.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_cookies.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_cookies.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_cookies.tcl Thu Mar 3 23:51:02 2011
@@ -7,15 +7,20 @@
## $Id$
##
###
-proc load_cookies {{arrayName cookies}} {
- upvar 1 $arrayName cookies
- set HTTP_COOKIE [env HTTP_COOKIE]
+namespace eval ::rivet {
- foreach pair [split $HTTP_COOKIE ";"] {
- set pair [split [string trim $pair] "="]
- set key [lindex $pair 0]
- set value [lindex $pair 1]
- set cookies($key) [list $value]
+ proc load_cookies {{arrayName cookies}} {
+ upvar 1 $arrayName cookies
+
+ set HTTP_COOKIE [env HTTP_COOKIE]
+
+ foreach pair [split $HTTP_COOKIE ";"] {
+ set pair [split [string trim $pair] "="]
+ set key [lindex $pair 0]
+ set value [lindex $pair 1]
+ set cookies($key) [list $value]
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_response.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_response.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_response.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/load_response.tcl Thu Mar 3 23:51:02 2011
@@ -9,20 +9,24 @@
##
###
-proc load_response {{arrayName response}} {
- upvar 1 $arrayName response
+namespace eval ::rivet {
- foreach {var elem} [var all] {
- if {[info exists response(__$var)]} {
- # we have seen var multiple times already, add to the list
- lappend response($var) $elem
- } elseif {[info exists response($var)]} {
- # second occurence of var, convert response(var) list:
- set response($var) [list $response($var) $elem]
- set response(__$var) ""
- } else {
- # first time seeing this var
- set response($var) $elem
- }
+ proc load_response {{arrayName response}} {
+ upvar 1 $arrayName response
+
+ foreach {var elem} [var all] {
+ if {[info exists response(__$var)]} {
+ # we have seen var multiple times already, add to the list
+ lappend response($var) $elem
+ } elseif {[info exists response($var)]} {
+ # second occurence of var, convert response(var) list:
+ set response($var) [list $response($var) $elem]
+ set response(__$var) ""
+ } else {
+ # first time seeing this var
+ set response($var) $elem
+ }
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/parray.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/parray.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/parray.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/parray.tcl Thu Mar 3 23:51:02 2011
@@ -11,22 +11,26 @@
##
###
-proc parray {arrayName {pattern *}} {
- upvar 1 $arrayName array
- if {![array exists array]} {
- return -code error "\"$arrayName\" isn't an array"
- }
- set maxl 0
- foreach name [lsort [array names array $pattern]] {
- if {[string length $name] > $maxl} {
- set maxl [string length $name]
+namespace eval ::rivet {
+
+ proc parray {arrayName {pattern *}} {
+ upvar 1 $arrayName array
+ if {![array exists array]} {
+ return -code error "\"$arrayName\" isn't an array"
}
+ set maxl 0
+ foreach name [lsort [array names array $pattern]] {
+ if {[string length $name] > $maxl} {
+ set maxl [string length $name]
+ }
+ }
+ puts stdout "<PRE><B>$arrayName</B>"
+ set maxl [expr {$maxl + [string length $arrayName] + 2}]
+ foreach name [lsort [array names array $pattern]] {
+ set nameString [format %s(%s) $arrayName $name]
+ puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
+ }
+ puts stdout "</PRE>"
}
- puts stdout "<PRE><B>$arrayName</B>"
- set maxl [expr {$maxl + [string length $arrayName] + 2}]
- foreach name [lsort [array names array $pattern]] {
- set nameString [format %s(%s) $arrayName $name]
- puts stdout [format "%-*s = %s" $maxl $nameString $array($name)]
- }
- puts stdout "</PRE>"
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/random.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/random.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/random.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/random.tcl Thu Mar 3 23:51:02 2011
@@ -12,18 +12,23 @@
## $Id$
##
###
-proc random {args} {
- global _ran
- if {[llength $args] > 1} {
- set _ran [lindex $args 1]
- } else {
- set period 233280
- if {[info exists _ran]} {
- set _ran [expr { ($_ran*9301 + 49297) % $period }]
- } else {
- set _ran [expr { [clock seconds] % $period } ]
- }
- return [expr { int($args*($_ran/double($period))) } ]
+namespace eval ::rivet {
+
+ proc random {args} {
+ global _ran
+
+ if {[llength $args] > 1} {
+ set _ran [lindex $args 1]
+ } else {
+ set period 233280
+ if {[info exists _ran]} {
+ set _ran [expr { ($_ran*9301 + 49297) % $period }]
+ } else {
+ set _ran [expr { [clock seconds] % $period } ]
+ }
+ return [expr { int($args*($_ran/double($period))) } ]
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/read_file.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/read_file.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/read_file.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/read_file.tcl Thu Mar 3 23:51:02 2011
@@ -8,9 +8,13 @@
##
###
-proc read_file {file} {
- set fp [open $file]
- set x [read $fp]
- close $fp
- return $x
+namespace eval ::rivet {
+
+ proc read_file {file} {
+ set fp [open $file]
+ set x [read $fp]
+ close $fp
+ return $x
+ }
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/rivet_command_document.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/rivet_command_document.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/rivet_command_document.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/rivet_command_document.tcl Thu Mar 3 23:51:02 2011
@@ -9,44 +9,48 @@
## $Id$
##
###
-proc rivet_command_document {list} {
- array set info $list
+namespace eval ::rivet {
- puts "<HEAD>"
- puts "<TITLE>$info(name) Documentation</TITLE>"
- puts "</HEAD>"
- puts "<BODY BGCOLOR=WHITE VLINK=blue>"
-
- puts "<CENTER>"
- puts {<FONT SIZE="+3">}
- puts "$info(name) - $info(package)"
- puts "</FONT>"
- puts "<BR>"
- puts "<B>"
- puts {<A HREF="#synopsis">Synopsis</A>}
- puts " * "
- puts {<A HREF="#description">Description</A>}
- if {[info exists info(seealso)]} {
- puts " * "
- puts {<A HREF="#seealso">See Also</A>}
- }
- puts "</B>"
- puts "</CENTER>"
-
- puts {<H3><A NAME="name" HREF="#name">Name</A></H3>}
- puts "<B>$info(name) - $info(short)</B>"
-
- if {![info exists info(command)]} { set info(command) $info(name) }
+ proc rivet_command_document {list} {
+ array set info $list
- puts {<H3><A NAME="synopsis" HREF="#synopsis">Synopsis</A></H3>}
- puts "$info(command)"
- if {[info exists info(arguments)]} { puts "<I>$info(arguments)</I>" }
-
- puts {<H3><A NAME="description" HREF="#description">Description</A></H3>}
- puts $info(description)
-
- if {[info exists info(seealso)]} {
- puts {<H3><A NAME="seealso" HREF="#seealso">See Also</A></H3>}
- puts $info(seealso)
+ puts "<HEAD>"
+ puts "<TITLE>$info(name) Documentation</TITLE>"
+ puts "</HEAD>"
+ puts "<BODY BGCOLOR=WHITE VLINK=blue>"
+
+ puts "<CENTER>"
+ puts {<FONT SIZE="+3">}
+ puts "$info(name) - $info(package)"
+ puts "</FONT>"
+ puts "<BR>"
+ puts "<B>"
+ puts {<A HREF="#synopsis">Synopsis</A>}
+ puts " * "
+ puts {<A HREF="#description">Description</A>}
+ if {[info exists info(seealso)]} {
+ puts " * "
+ puts {<A HREF="#seealso">See Also</A>}
+ }
+ puts "</B>"
+ puts "</CENTER>"
+
+ puts {<H3><A NAME="name" HREF="#name">Name</A></H3>}
+ puts "<B>$info(name) - $info(short)</B>"
+
+ if {![info exists info(command)]} { set info(command) $info(name) }
+
+ puts {<H3><A NAME="synopsis" HREF="#synopsis">Synopsis</A></H3>}
+ puts "$info(command)"
+ if {[info exists info(arguments)]} { puts "<I>$info(arguments)</I>" }
+
+ puts {<H3><A NAME="description" HREF="#description">Description</A></H3>}
+ puts $info(description)
+
+ if {[info exists info(seealso)]} {
+ puts {<H3><A NAME="seealso" HREF="#seealso">See Also</A></H3>}
+ puts $info(seealso)
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/tclIndex
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/tclIndex?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/tclIndex (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/tclIndex Thu Mar 3 23:51:02 2011
@@ -6,21 +6,18 @@
# element name is the name of a command and the value is
# a script that loads the command.
-set auto_index(lempty) [list source [file join $dir lempty.tcl]]
-set auto_index(load_response) [list source [file join $dir load_response.tcl]]
-set auto_index(random) [list source [file join $dir random.tcl]]
-set auto_index(import_switch_args) [list source [file join $dir import_switch_args.tcl]]
-set auto_index(rivet_command_document) [list source [file join $dir rivet_command_document.tcl]]
-set auto_index(html) [list source [file join $dir html.tcl]]
-set auto_index(load_cookies) [list source [file join $dir load_cookies.tcl]]
-set auto_index(debug) [list source [file join $dir debug.tcl]]
-set auto_index(lassign) [list source [file join $dir lassign.tcl]]
-set auto_index(import_keyvalue_pairs) [list source [file join $dir import_keyvalue_pairs.tcl]]
-set auto_index(read_file) [list source [file join $dir read_file.tcl]]
-set auto_index(lmatch) [list source [file join $dir lmatch.tcl]]
-set auto_index(clock_to_rfc850_gmt) [list source [file join $dir cookie.tcl]]
-set auto_index(make_cookie_attributes) [list source [file join $dir cookie.tcl]]
-set auto_index(cookie) [list source [file join $dir cookie.tcl]]
-set auto_index(wrap) [list source [file join $dir wrap.tcl]]
-set auto_index(wrapline) [list source [file join $dir wrap.tcl]]
-set auto_index(parray) [list source [file join $dir parray.tcl]]
+set auto_index(::rivet::html) [list source [file join $dir html.tcl]]
+set auto_index(incr0) [list source [file join $dir incr0.tcl]]
+set auto_index(::rivet::lassign) [list source [file join $dir lassign.tcl]]
+set auto_index(::rivet::random) [list source [file join $dir random.tcl]]
+set auto_index(::rivet::rivet_command_document) [list source [file join $dir rivet_command_document.tcl]]
+set auto_index(::rivet::load_response) [list source [file join $dir load_response.tcl]]
+set auto_index(::rivet::debug) [list source [file join $dir debug.tcl]]
+set auto_index(::rivet::lempty) [list source [file join $dir lempty.tcl]]
+set auto_index(::rivet::lmatch) [list source [file join $dir lmatch.tcl]]
+set auto_index(::rivet::read_file) [list source [file join $dir read_file.tcl]]
+set auto_index(::rivet::import_keyvalue_pairs) [list source [file join $dir import_keyvalue_pairs.tcl]]
+set auto_index(::rivet::parray) [list source [file join $dir parray.tcl]]
+set auto_index(::rivet::wrap) [list source [file join $dir wrap.tcl]]
+set auto_index(::rivet::wrapline) [list source [file join $dir wrap.tcl]]
+set auto_index(::rivet::load_cookies) [list source [file join $dir load_cookies.tcl]]
Modified: tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/wrap.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/wrap.tcl?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/wrap.tcl (original)
+++ tcl/rivet/branches/rivet-namespace/rivet/rivet-tcl/wrap.tcl Thu Mar 3 23:51:02 2011
@@ -10,17 +10,19 @@
##
###
-proc wrap {string maxlen {html ""}} {
- set splitstring {}
- foreach line [split $string "\n"] {
- lappend splitstring [wrapline $line $maxlen $html]
- }
- if {$html == "-html"} {
- return [join $splitstring "<br>"]
- } else {
- return [join $splitstring "\n"]
+namespace eval ::rivet {
+
+ proc wrap {string maxlen {html ""}} {
+ set splitstring {}
+ foreach line [split $string "\n"] {
+ lappend splitstring [wrapline $line $maxlen $html]
+ }
+ if {$html == "-html"} {
+ return [join $splitstring "<br>"]
+ } else {
+ return [join $splitstring "\n"]
+ }
}
-}
##
## wrapline -- Given a line and a maximum length and option "-html"
@@ -31,20 +33,22 @@ proc wrap {string maxlen {html ""}} {
## the lines separated by html <br> line breaks, otherwise the lines
## are returned separated by newline characters.
##
-proc wrapline {line maxlen {html ""}} {
- set string [split $line " "]
- set newline [list [lindex $string 0]]
- foreach word [lrange $string 1 end] {
- if {[string length $newline]+[string length $word] > $maxlen} {
- lappend lines [join $newline " "]
- set newline {}
- }
- lappend newline $word
- }
- lappend lines [join $newline " "]
- if {$html == "-html"} {
- return [join $lines <br>]
- } else {
- return [join $lines "\n"]
+ proc wrapline {line maxlen {html ""}} {
+ set string [split $line " "]
+ set newline [list [lindex $string 0]]
+ foreach word [lrange $string 1 end] {
+ if {[string length $newline]+[string length $word] > $maxlen} {
+ lappend lines [join $newline " "]
+ set newline {}
+ }
+ lappend newline $word
+ }
+ lappend lines [join $newline " "]
+ if {$html == "-html"} {
+ return [join $lines <br>]
+ } else {
+ return [join $lines "\n"]
+ }
}
+
}
Modified: tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.c
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.c?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.c (original)
+++ tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.c Thu Mar 3 23:51:02 2011
@@ -337,6 +337,7 @@ Rivet_ExecuteAndCheck(Tcl_Interp *interp
*/
errorCodeListObj = Tcl_GetVar2Ex (interp, "errorCode", (char *)NULL, TCL_GLOBAL_ONLY);
+
/* errorCode is guaranteed to be set to NONE, but let's make sure
* anyway rather than causing a SIGSEGV
*/
@@ -360,7 +361,17 @@ Rivet_ExecuteAndCheck(Tcl_Interp *interp
ap_assert (Tcl_ListObjIndex (interp, errorCodeListObj, 1, &errorCodeElementObj) == TCL_OK);
errorCodeSubString = Tcl_GetString (errorCodeElementObj);
- if (strcmp (errorCodeSubString, "ABORTPAGE") == 0) {
+ if (strcmp (errorCodeSubString, "ABORTPAGE") == 0)
+ {
+ if (conf->rivet_abort_script)
+ {
+ if (Tcl_EvalObjEx(interp,conf->rivet_abort_script,0) == TCL_ERROR)
+ {
+ CONST84 char *errorinfo = Tcl_GetVar( interp, "errorInfo", 0 );
+ TclWeb_PrintError("<b>Rivet ErrorScript failed!</b>",1,globals->req);
+ TclWeb_PrintError( errorinfo, 0, globals->req );
+ }
+ }
goto good;
}
}
@@ -371,7 +382,6 @@ Rivet_ExecuteAndCheck(Tcl_Interp *interp
/* If we don't have an error script, use the default error handler. */
if (conf->rivet_error_script ) {
-// errscript = Tcl_NewStringObj(conf->rivet_error_script, -1);
errscript = conf->rivet_error_script;
} else {
errscript = conf->rivet_default_error_script;
@@ -391,6 +401,15 @@ Rivet_ExecuteAndCheck(Tcl_Interp *interp
/* Make sure to flush the output if buffer_add was the only output */
good:
+
+ if (conf->after_every_script) {
+ if (Tcl_EvalObjEx(interp,conf->after_every_script,0) == TCL_ERROR)
+ {
+ CONST84 char *errorinfo = Tcl_GetVar( interp, "errorInfo", 0 );
+ TclWeb_PrintError("<b>Rivet AfterEveryScript failed!</b>",1,globals->req);
+ TclWeb_PrintError( errorinfo, 0, globals->req );
+ }
+ }
if (!globals->req->headers_set && (globals->req->charset != NULL)) {
TclWeb_SetHeaderType (apr_pstrcat(globals->req->req->pool,"text/html;",globals->req->charset,NULL),globals->req);
@@ -575,6 +594,8 @@ Rivet_ParseExecFile(TclWebRequest *req,
static void
Rivet_CleanupRequest( request_rec *r )
{
+
+
#if 0
apr_table_t *t;
apr_array_header_t *arr;
@@ -641,6 +662,8 @@ Rivet_CopyConfig( rivet_server_conf *old
newrsc->rivet_before_script = oldrsc->rivet_before_script;
newrsc->rivet_after_script = oldrsc->rivet_after_script;
newrsc->rivet_error_script = oldrsc->rivet_error_script;
+ newrsc->rivet_abort_script = oldrsc->rivet_abort_script;
+ newrsc->after_every_script = oldrsc->after_every_script;
newrsc->user_scripts_updated = oldrsc->user_scripts_updated;
@@ -680,6 +703,10 @@ Rivet_MergeDirConfigVars(apr_pool_t *p,
add->rivet_after_script : base->rivet_after_script;
new->rivet_error_script = add->rivet_error_script ?
add->rivet_error_script : base->rivet_error_script;
+ new->rivet_abort_script = add->rivet_abort_script ?
+ add->rivet_abort_script : base->rivet_abort_script;
+ new->after_every_script = add->after_every_script ?
+ add->after_every_script : base->after_every_script;
new->user_scripts_updated = add->user_scripts_updated ?
add->user_scripts_updated : base->user_scripts_updated;
@@ -745,6 +772,8 @@ Rivet_CreateConfig(apr_pool_t *p, server
rsc->rivet_before_script = NULL;
rsc->rivet_after_script = NULL;
rsc->rivet_error_script = NULL;
+ rsc->rivet_abort_script = NULL;
+ rsc->after_every_script = NULL;
rsc->user_scripts_updated = 0;
@@ -869,10 +898,20 @@ Rivet_PerInterpInit(server_rec *s, rivet
globals = apr_pcalloc(p, sizeof(rivet_interp_globals));
Tcl_SetAssocData(interp,"rivet",NULL,globals);
+
+ /*
+ * abort_page status variables in globals are set here and then
+ * reset in Rivet_SendContent just before the request processing is
+ * completed
+ */
/* Rivet commands namespace is created */
globals->rivet_ns = Tcl_CreateNamespace (interp,RIVET_NS,NULL,
(Tcl_NamespaceDeleteProc *)NULL);
+ globals->page_aborting = 0;
+ globals->abort_code = NULL;
+
+ /* Eval Rivet's init.tcl file to load in the Tcl-level commands. */
/* We put in front the auto_path list the path to the directory where
* init.tcl is located (provides package RivetTcl)
@@ -913,18 +952,17 @@ Rivet_PerInterpInit(server_rec *s, rivet
* It's been so far impossible to understand why the following call to Tcl_PkgRequire
* causes a segfault later on in Rivet_ServerConf when Apache reconstructs the
* configuration record (weird behavior of the framework, still it was confirmed by
- * the people at Apache). Commands in rivetWWW.c are now setup by rivetCore.c
+ * the people at Apache).
*/
/*
- if (Tcl_PkgRequire(interp, "FakeLib", "1.2", 1) == NULL)
+ if (Tcl_PkgRequire(interp, RIVETLIB_TCL_PACKAGE, "1.2", 1) == NULL)
{
ap_log_error( APLOG_MARK, APLOG_ERR, APR_EGENERAL, s,
- "init.tcl must be installed correctly for Apache Rivet to function: %s",
- Tcl_GetStringResult(interp) );
+ "Error loading rivetlib package: %s", Tcl_GetStringResult(interp) );
exit(1);
}
*/
-
+
/* Set the output buffer size to the largest allowed value, so that we
* won't send any result packets to the browser unless the Rivet
* programmer does a "flush stdout" or the page is completed.
@@ -1014,6 +1052,10 @@ Rivet_SetScript (apr_pool_t *pool, rivet
objarg = Rivet_AssignStringToConf(&(rsc->rivet_error_script),string);
} else if( STREQU( script, "ServerInitScript" ) ) {
objarg = Rivet_AssignStringToConf(&(rsc->rivet_server_init_script),string);
+ } else if( STREQU( script, "AbortScript" ) ) {
+ objarg = Rivet_AssignStringToConf(&(rsc->rivet_abort_script),string);
+ } else if( STREQU( script, "AfterEveryScript" ) ) {
+ objarg = Rivet_AssignStringToConf(&(rsc->after_every_script),string);
}
if( !objarg ) return string;
@@ -1265,6 +1307,12 @@ Rivet_MergeConfig(apr_pool_t *p, void *b
rsc->rivet_default_error_script = overrides->rivet_default_error_script ?
overrides->rivet_default_error_script : base->rivet_default_error_script;
+ rsc->rivet_abort_script = overrides->rivet_abort_script ?
+ overrides->rivet_abort_script : base->rivet_abort_script;
+
+ rsc->after_every_script = overrides->after_every_script ?
+ overrides->after_every_script : base->after_every_script;
+
/* cache_size is global, and set up later. */
/* cache_free is not set up at this point. */
@@ -1850,6 +1898,14 @@ Rivet_SendContent(request_rec *r)
retval = OK;
sendcleanup:
globals->req->content_sent = 0;
+
+ globals->page_aborting = 0;
+ if (globals->abort_code != NULL)
+ {
+ Tcl_DecrRefCount(globals->abort_code);
+ globals->abort_code = NULL;
+ }
+
Tcl_MutexUnlock(&sendMutex);
return retval;
}
Modified: tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.h
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.h?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.h (original)
+++ tcl/rivet/branches/rivet-namespace/src/apache-2/mod_rivet.h Thu Mar 3 23:51:02 2011
@@ -74,15 +74,18 @@ typedef struct _rivet_server_conf {
Tcl_Obj *rivet_global_init_script; /* run once when apache is started */
Tcl_Obj *rivet_child_init_script;
Tcl_Obj *rivet_child_exit_script;
- Tcl_Obj *rivet_before_script; /* script run before each page */
- Tcl_Obj *rivet_after_script; /* after */
- Tcl_Obj *rivet_error_script; /* for errors */
+ Tcl_Obj *rivet_before_script; /* script run before each page */
+ Tcl_Obj *rivet_after_script; /* after */
+ Tcl_Obj *rivet_error_script; /* for errors */
+ Tcl_Obj *rivet_abort_script; /* script run upon abort_page call */
+ Tcl_Obj *after_every_script; /* script to be run always */
+
+ /* This flag is used with the above directives.
+ If any of them have changed, it gets set. */
- /* This flag is used with the above directives. If any of them
- have changed, it gets set. */
int user_scripts_updated;
- Tcl_Obj *rivet_default_error_script; /* for errors */
+ Tcl_Obj *rivet_default_error_script; /* for errors */
int *cache_size;
int *cache_free;
int upload_max;
@@ -97,16 +100,18 @@ typedef struct _rivet_server_conf {
char **objCacheList; /* Array of cached objects (for priority handling) */
Tcl_HashTable *objCache; /* Objects cache - the key is the script name */
- Tcl_Channel *outchannel; /* stuff for buffering output */
+ Tcl_Channel *outchannel; /* stuff for buffering output */
} rivet_server_conf;
-/* eventually we will transfer 'global' variables in here and
- 'de-globalize' them */
+/* eventually we will transfer 'global' variables in here and 'de-globalize' them */
typedef struct _rivet_interp_globals {
request_rec *r; /* request rec */
TclWebRequest *req; /* TclWeb API request */
Tcl_Namespace *rivet_ns; /* Rivet commands namespace */
+ int page_aborting; /* set by abort_page. */
+ /* to be reset by Rivet_SendContent */
+ Tcl_Obj* abort_code;
} rivet_interp_globals;
int Rivet_ParseExecFile(TclWebRequest *req, char *filename, int toplevel);
@@ -126,6 +131,5 @@ rivet_server_conf *Rivet_GetConf(request
#define RIVET_NEW_CONF(p) \
(rivet_server_conf *)apr_pcalloc(p, sizeof(rivet_server_conf))
-
#endif /* MOD_RIVET_H */
Modified: tcl/rivet/branches/rivet-namespace/src/apache-2/rivetCore.c
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/src/apache-2/rivetCore.c?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/src/apache-2/rivetCore.c (original)
+++ tcl/rivet/branches/rivet-namespace/src/apache-2/rivetCore.c Thu Mar 3 23:51:02 2011
@@ -646,9 +646,9 @@ TCL_CMD_HEADER( Rivet_ApacheTable )
}
if (Tcl_GetIndexFromObj (interp, objv[2], tableNames,
- "notes|headers_in|headers_out|err_header_out|subprocess_env",
- 0, &tableindex) == TCL_ERROR) {
- return TCL_ERROR;
+ "notes|headers_in|headers_out|err_header_out|subprocess_env",
+ 0, &tableindex) == TCL_ERROR) {
+ return TCL_ERROR;
}
switch ((enum tablename)tableindex)
@@ -689,7 +689,6 @@ TCL_CMD_HEADER( Rivet_ApacheTable )
Tcl_WrongNumArgs(interp, 2, objv, "tablename key");
return TCL_ERROR;
}
-
key = Tcl_GetString (objv[3]);
value = apr_table_get (table, key);
@@ -698,7 +697,6 @@ TCL_CMD_HEADER( Rivet_ApacheTable )
}
break;
}
-
case SUB_EXISTS: {
const char *key;
const char *value;
@@ -714,8 +712,6 @@ TCL_CMD_HEADER( Rivet_ApacheTable )
Tcl_SetObjResult (interp, Tcl_NewBooleanObj (value != NULL));
break;
}
-
-
case SUB_SET: {
int i;
char *key;
@@ -1043,14 +1039,52 @@ TCL_CMD_HEADER( Rivet_NoBody )
TCL_CMD_HEADER( Rivet_AbortPageCmd )
{
+ rivet_interp_globals *globals = Tcl_GetAssocData( interp, "rivet", NULL );
static char *errorMessage = "Page generation terminated by abort_page directive";
- if (objc != 1)
+ if (objc > 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
+ if (objc == 2)
+ {
+ char* cmd_arg = Tcl_GetStringFromObj(objv[1],NULL);
+
+ if (strcmp(cmd_arg,"-aborting") == 0)
+ {
+ Tcl_SetObjResult (interp,Tcl_NewBooleanObj(globals->page_aborting));
+ return TCL_OK;
+ }
+
+ /*
+ * we assume abort_code to be null, as abort_page shouldn't run twice while
+ * processing the same request
+ */
+
+ if (globals->abort_code == NULL)
+ {
+ globals->abort_code = objv[1];
+ Tcl_IncrRefCount(globals->abort_code);
+ }
+ }
+
+ /*
+ * If page_aborting is true then this is the second call to abort_page
+ * processing the same request: we ignore it and return a normal
+ * completion code
+ */
+
+ if (globals->page_aborting)
+ {
+ return TCL_OK;
+ }
+
+ /* this is the first (and supposedly unique) abort_page call during this request */
+
+ globals->page_aborting = 1;
+
Tcl_AddErrorInfo (interp, errorMessage);
Tcl_SetErrorCode (interp, "RIVET", "ABORTPAGE", errorMessage, (char *)NULL);
return TCL_ERROR;
@@ -1058,6 +1092,28 @@ TCL_CMD_HEADER( Rivet_AbortPageCmd )
/*
*-----------------------------------------------------------------------------
+ * Rivet_AbortCodeCmd --
+ *
+ * Returns the abort code stored internally by passing a user defined parameter
+ * to the command 'abort_page'.
+ *
+ *
+ *-----------------------------------------------------------------------------
+ */
+TCL_CMD_HEADER( Rivet_AbortCodeCmd )
+{
+ rivet_interp_globals *globals = Tcl_GetAssocData( interp, "rivet", NULL );
+
+ if (globals->abort_code != NULL)
+ {
+ Tcl_SetObjResult(interp,globals->abort_code);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *-----------------------------------------------------------------------------
*
* Rivet_EnvCmd --
*
@@ -1323,5 +1379,9 @@ Rivet_InitCore( Tcl_Interp *interp )
RIVET_OBJ_CMD ("testpanic",TestpanicCmd,rivet_ns);
#endif
+ TCL_OBJ_CMD( "abort_page", Rivet_AbortPageCmd );
+ TCL_OBJ_CMD( "abort_code", Rivet_AbortCodeCmd );
+ TCL_OBJ_CMD( "virtual_filename", Rivet_VirtualFilenameCmd );
+
return Tcl_PkgProvide( interp, RIVET_TCL_PACKAGE, "1.2" );
}
Modified: tcl/rivet/branches/rivet-namespace/src/rivetPkgInit.c
URL: http://svn.apache.org/viewvc/tcl/rivet/branches/rivet-namespace/src/rivetPkgInit.c?rev=1076894&r1=1076893&r2=1076894&view=diff
==============================================================================
--- tcl/rivet/branches/rivet-namespace/src/rivetPkgInit.c (original)
+++ tcl/rivet/branches/rivet-namespace/src/rivetPkgInit.c Thu Mar 3 23:51:02 2011
@@ -77,7 +77,9 @@ Rivetlib_Init( Tcl_Interp *interp )
* safe for use in safe interpreters, into a safe interpreter.
*
* Parameters:
+ *
* o interp - Interpreter to add commands to.
+ *
*-----------------------------------------------------------------------------
*/
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-cvs-help@tcl.apache.org