You are viewing a plain text version of this content. The canonical link for it is here.
Posted to site-cvs@tcl.apache.org by da...@apache.org on 2016/11/22 17:04:19 UTC
svn commit: r1770860 - /tcl/rivet/trunk/rivet/init.tcl.in
Author: damonc
Date: Tue Nov 22 17:04:19 2016
New Revision: 1770860
URL: http://svn.apache.org/viewvc?rev=1770860&view=rev
Log:
Rewrite init.tcl.in from the top down.
Modified:
tcl/rivet/trunk/rivet/init.tcl.in
Modified: tcl/rivet/trunk/rivet/init.tcl.in
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/init.tcl.in?rev=1770860&r1=1770859&r2=1770860&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/init.tcl.in (original)
+++ tcl/rivet/trunk/rivet/init.tcl.in Tue Nov 22 17:04:19 2016
@@ -12,51 +12,77 @@
# See the License for the specific language governing permissions and
# limitations under the License.
-package provide Rivet @INIT_VERSION@
-
-namespace eval ::Rivet {} ; ## create the namespace
+namespace eval ::rivet {} ; ## create namespace
+namespace eval ::Rivet {} ; ## create namespace
-###
-## -- tcl_commands_export_list
-#
-## this is temporary hack to export names of Tcl commands in rivet-tcl/.
-## This function will be removed in future versions of Rivet and it's
-## meant to provide a basic way to guarantee compatibility with older
-## versions of Rivet (see code in ::Rivet::init)
+## ::Rivet::init
##
+## Initialize the interpreter with all that Rivet goodness. This is called
+## once when this file is loaded (down at the bottom) and sets up the interp
+## for all things Rivet.
-proc ::Rivet::tcl_commands_export_list {tclpath} {
-
- # we collect the commands in rivet-tcl by reading the tclIndex
- # file and then we extract the command list from auto_index
-
- namespace eval ::rivet_temp { }
- set ::rivet_temp::tclpath $tclpath
-
- namespace eval ::rivet_temp {
- variable auto_index
- array set auto_index {}
+proc ::Rivet::init {} {
+ set ::Rivet::init [info script]
+ set ::Rivet::root [file dirname $::Rivet::init]
+ set ::Rivet::packages [file join $::Rivet::root packages]
+ set ::Rivet::rivet_tcl [file join $::Rivet::root rivet-tcl]
+
+ ## Setup auto_path within the interp to include all the places
+ ## we've stored Rivet's scripts: rivet-tcl, packages, packages-local,
+ ## packages$tcl_version, init_script_dir, and .
+
+ ## Put these at the head of the list.
+ set ::auto_path [linsert $::auto_path 0 $::Rivet::root \
+ $::Rivet::rivet_tcl $::Rivet::packages $::Rivet::packages-local]
- # the auto_index in ${tclpath}/tclIndex is loaded
- # this array is used to fetch a list of Rivet commands
- # implemented in Rivet
+ ## This will allow users to create proc libraries and tclIndex files
+ ## in the local directory that can be autoloaded.
+ ## Perhaps this must go to the front of the list to allow the user
+ ## to override even Rivet's procs.
+ lappend ::auto_path $::Rivet::packages$::tcl_version .
- set dir $tclpath
- source [file join $tclpath tclIndex]
+ ## As we moved the commands set to the ::rivet namespace we
+ ## we want to guarantee the commands are still accessible
+ ## at the global level by putting them on the export list.
+ ## Importing the ::rivet namespace is deprecated and we should
+ ## make it clear in the manual.
- # Rivet Tcl commands not meant to go onto the export list must
- # be unset from auto_index here
+ set ::rivet::cmd_export_list [tcl_commands_export_list $::Rivet::rivet_tcl]
+ if {[info exists ::module_conf(export_namespace_commands)]
+ && $::module_conf(export_namespace_commands)} {
+
+ ## init.tcl is run by mod_rivet (which creates the ::rivet
+ ## namespace) but it gets run standalone by mkPkgindex during
+ ## the installation phase. We have to make sure the procedure
+ ## won't fail in this case, so we check for the existence of
+ ## the variable.
+ namespace eval ::rivet {
+ ## Commands in cmd_export_list are prefixed with ::rivet,
+ ## so we have to remove it to build an export list.
+ set export_list [list]
+ foreach c $cmd_export_list {
+ lappend export_list [namespace tail $c]
+ }
- unset auto_index(::rivet::catch)
- unset auto_index(::rivet::try)
+ namespace export {*}$export_list
+ }
}
- set command_list [namespace eval ::rivet_temp {array names auto_index}]
-
- # we won't leave anything behind
- namespace delete ::rivet_temp
+ ## Move Tcl's exit command out of the way and replace it with
+ ## our own that handles bailing from a page request properly.
+ rename ::exit ::Rivet::tclcore_exit
+ proc ::exit {code} {
+ if {![string is integer -strict $code]} { set code 0 }
+ ::rivet::exit $code
+ }
- return $command_list
+ ## If Rivet was configured for backward compatibility, import commands
+ ## from the ::rivet namespace into the global namespace.
+ if {[info exists ::module_conf(import_rivet_commands)]
+ && $::module_conf(import_rivet_commands)} {
+ uplevel #0 { namespace import ::rivet::* }
+ }
+ unset -nocomplain ::module_conf
}
###
@@ -69,7 +95,7 @@ proc ::Rivet::tcl_commands_export_list {
proc ::Rivet::initialize_request {} {
catch { namespace delete ::request }
- namespace eval ::request { }
+ namespace eval ::request {}
proc ::request::global {args} {
foreach arg $args {
@@ -78,249 +104,143 @@ proc ::Rivet::initialize_request {} {
}
}
-###
-## The default error handler for Rivet. Any time a page runs into an
-## error, this routine will be called to handle the error information.
-## If an ErrorScript has been specified, this routine will not be called.
-###
-proc ::Rivet::handle_error {} {
- global errorInfo
- global errorOutbuf
-
- puts <PRE>
- puts "<HR>$errorInfo<HR>"
- puts "<P><B>OUTPUT BUFFER:</B></P>"
- puts $errorOutbuf
- puts </PRE>
-}
-
-###
-## This routine gets called each time a request is finished. Any kind
-## of special cleanup can be placed here.
-###
-proc ::Rivet::cleanup_request {} { }
-
-
-######## mod_rivet_ng specific ++++++++
-
-###
-# -- error_message
-#
-# this message should be transparently equivalent
-# to the Rivet_PrintErrorMessage function in mod_rivet_generator.c
-#
-
-proc ::Rivet::print_error_message {error_header} {
- global errorInfo
-
- puts "$error_header <br/>"
- puts "<pre> $errorInfo </pre>"
-
-}
-
-
-###
-## -- error_handler
+## ::Rivet::cleanup_request
##
-###
-
-proc ::Rivet::error_handler {script err_code err_options} {
- global errorOutbuf
+## This routine gets called each time a request is finished. Any kind
+## of special cleanup can be placed here. We don't do anything by default.
- set error_script [::rivet::inspect ErrorScript]
- if {$error_script != ""} {
- if {[catch {namespace eval :: $error_script} err_code err_info]} {
- ::rivet::apache_log_err err "error script failed ($errorInfo)"
- print_error_message "<b>Rivet ErrorScript failed</b>"
- }
- } else {
- set errorOutbuf [string trim $script]
- ::Rivet::handle_error
- }
-}
+proc ::Rivet::cleanup_request {} {}
-###
-## -- url_handler
+## ::Rivet::handle_error
##
-###
-
-proc ::Rivet::url_handler {} {
-
- set script [join [list [::rivet::inspect BeforeScript] \
- [::rivet::url_script] \
- [::rivet::inspect AfterScript]] "\n"]
-
- #set fp [open "/tmp/script-[pid].tcl" w+]
- #puts $fp $script
- #close $fp
-
- return $script
+## If an ErrorScript has been specified, this routine will not be called.
+proc ::Rivet::handle_error {} {
+ puts "<pre>$::errorInfo<hr/><p>OUTPUT BUFFER:</p>$::Rivet::script</pre>"
}
-###
-## -- Default request processing
+## ::Rivet::request_handling
##
-## a request will handled by this procedure
+## Process the actual request. This is the main handler for each request.
+## This collects all of the necessary BeforeScripts, AfterScripts, and
+## other bits and calls them in order.
proc ::Rivet::request_handling {} {
-
- set script [::Rivet::url_handler]
-
::try {
-
- namespace eval :: $script
-
- } trap {RIVET ABORTPAGE} {::Rivet::error_code ::Rivet::error_options} {
-
- set abort_script [::rivet::inspect AbortScript]
- if {[catch {namespace eval :: $abort_script} ::Rivet::error_code ::Rivet::error_options]} {
- ::rivet::apache_log_err err "abort script failed ($errorInfo)"
- print_error_message "<b>Rivet AbortScript failed</b>"
-
- ::Rivet::error_handler $abort_script $::Rivet::error_code $::Rivet::error_options
- }
-
-
- } trap {RIVET THREAD_EXIT} {::Rivet::error_code ::Rivet::error_options} {
-
- set abort_script [::rivet::inspect AbortScript]
- if {[catch {namespace eval :: $abort_script} ::Rivet::error_code ::Rivet::error_options]} {
- ::rivet::apache_log_err err "abort script failed ($errorInfo)"
- print_error_message "<b>Rivet AbortScript failed</b>"
-
- ::Rivet::error_handler $abort_script $::Rivet::error_code $::Rivet::error_options
- }
-
- #<sudden-exit-script>
-
- } on error {::Rivet::error_code ::Rivet::error_options} {
-
- ::Rivet::error_handler $script $::Rivet::error_code $::Rivet::error_options
-
+ set script [::rivet::inspect BeforeScript]
+ if {$script ne ""} {
+ set ::Rivet::script $script
+ uplevel #0 $script
+ }
+
+ set script [::rivet::url_script]
+ if {$script ne ""} {
+ set ::Rivet::script $script
+ uplevel #0 $script
+ }
+
+ set script [::rivet::inspect AfterScript]
+ if {$script ne ""} {
+ set ::Rivet::script $script
+ uplevel #0 $script
+ }
+ } trap {RIVET ABORTPAGE} {err opts} {
+ ::Rivet::finish_request $script $err $opts AbortScript
+ } trap {RIVET THREAD_EXIT} {err opts} {
+ ::Rivet::finish_request $script $err $opts AbortScript
+ } on error {err opts} {
+ ::Rivet::finish_request $script $err $opts
} finally {
-
- set after_every_script [::rivet::inspect AfterEveryScript]
- if {[catch {namespace eval :: $after_every_script} ::Rivet::error_code ::Rivet::error_options]} {
- ::rivet::apache_log_err err "AfterEveryScript failed ($errorInfo)"
- print_error_message "<b>Rivet AfterEveryScript failed</b>"
-
- ::Rivet::error_handler $after_every_script $::Rivet::error_code $::Rivet::error_options
- }
- #<after-every-script>
+ ::Rivet::finish_request $script "" "" AfterEveryScript
}
- namespace eval :: ::Rivet::cleanup_request
+ catch {uplevel #0 ::Rivet::cleanup_request}
}
-######## mod_rivet_ng specific ---------
-
-###
-## The main initialization procedure for Rivet.
-###
-
-proc ::Rivet::init {} {
- global auto_path
- global server
-
- ## Add the rivet-tcl directory to Tcl's auto search path.
- ## We insert it at the head of the list because we want any of
- ## our procs named the same as Tcl's procs to be overridden.
- ## Example: parray
- set tclpath [file join [file dirname [info script]] rivet-tcl]
- set auto_path [linsert $auto_path 0 $tclpath]
-
- ## As we moved the commands set to ::rivet namespace we
- ## we want to guarantee the commands are still accessible
- ## at global level by putting them on the export list.
- ## Importing the ::rivet namespace is deprecated and we should
- ## make it clear in the manual
-
- ## we keep in ::rivet::export_list a list of importable commands
-
- namespace eval ::rivet [list set cmd_export_list [tcl_commands_export_list $tclpath]]
- namespace eval ::rivet {
-
- ## init.tcl is run by mod_rivet (which creates the ::rivet namespace) but it gets run
- ## standalone by mkPkgindex during the installation phase. We have to make sure the
- ## procedure won't fail in this case, so we check for the existence of the variable.
-
- if {[info exists module_conf(export_namespace_commands)] && \
- $module_conf(export_namespace_commands)} {
-
- # commands in 'command_list' are prefixed with ::rivet, so we have to
- # remove it to build an export list
-
- set export_list {}
- foreach c $cmd_export_list {
- lappend export_list [namespace tail $c]
- }
-
- #puts stderr "exporting $export_list"
- eval namespace export $export_list
-
+## ::Rivet::finish_request
+##
+## Finish processing the request by checking our error state and executing
+## whichever script we need to close things up. If this script results in
+## an error, we'll try to call ErrorScript before bailing.
+
+proc ::Rivet::finish_request {script errorCode errorOpts {scriptName ""}} {
+ set ::Rivet::errorCode $errorCode
+ set ::Rivet::errorOpts $errorOpts
+
+ if {$scriptName ne ""} {
+ set scriptBody [::rivet::inspect $scriptName]
+ ::try {
+ uplevel #0 $scriptBody
+ } on ok {} {
+ return
+ } on error {} {
+ ::rivet::apache_log_err err "$scriptName failed: $::errorInfo"
+ print_error_message "Rivet $scriptName failed"
}
}
- ## Add the packages directory to the auto_path.
- ## If we have a packages$tcl_version directory
- ## (IE: packages8.3, packages8.4) append that as well.
-
- ## The packages directory come right after the rivet-tcl directory.
- set pkgpath [file join [file dirname [info script]] packages]
- set auto_path [linsert $auto_path 1 $pkgpath]
- set auto_path [linsert $auto_path 2 ${pkgpath}-local]
- if { [file exists ${pkgpath}$::tcl_version] } {
- lappend auto_path ${pkgpath}$::tcl_version
+ set error_script [::rivet::inspect ErrorScript]
+ if {$error_script eq ""} {
+ set ::errorOutbuf $script ; ## legacy variable
+ set error_script ::Rivet::handle_error
}
- ## Likewise we have also to add to auto_path the directory containing
- ## this script since it holds the pkgIndex.tcl file for package Rivet.
-
- set auto_path [linsert $auto_path 0 [file dirname [info script]]]
-
- ## This will allow users to create proc libraries and tclIndex files
- ## in the local directory that can be autoloaded.
- ## Perhaps this must go to the front of the list to allow the user
- ## to override even Rivet's procs.
- lappend auto_path .
+ ::try {
+ uplevel #0 $error_script
+ } on error {err} {
+ ::rivet::apache_log_err err "ErrorScript failed: $::errorInfo"
+ print_error_message "Rivet ErrorScript failed"
+ }
}
-## eventually we have to divert Tcl ::exit to ::rivet::exit
+## ::Rivet::print_error_message
+##
+## This message should be transparently equivalent to the
+## Rivet_PrintErrorMessage function in mod_rivet_generator.c
-rename ::exit ::Rivet::tclcore_exit
-proc ::exit {code} {
+proc ::Rivet::print_error_message {error_header} {
+ puts "<strong>$error_header</strong><br/><pre>$::errorInfo</pre>"
+}
- if {[string is integer $code]} {
- eval ::rivet::exit $code
- } else {
- eval ::rivet::exit 0
- }
+## ::Rivet::tcl_commands_export_list
+##
+## this is temporary hack to export names of Tcl commands in rivet-tcl/.
+## This function will be removed in future versions of Rivet and it's
+## meant to provide a basic way to guarantee compatibility with older
+## versions of Rivet (see code in ::Rivet::init)
-}
+proc ::Rivet::tcl_commands_export_list {tclpath} {
+ # we collect the commands in rivet-tcl by reading the tclIndex
+ # file and then we extract the command list from auto_index
+ namespace eval ::Rivet::temp {}
+ set ::Rivet::temp::tclpath $tclpath
-## Rivet 2.1.x supports Tcl >= 8.5, therefore there's no more need for
-## the command incr0, as the functionality of creating a not yet
-## existing variable is now provided by 'incr'. Being incr0 a command
-## in Rivet < 2.1.0, before the move into the ::Rivet namespace,
-## we alias this command only in the global namespace
+ namespace eval ::Rivet::temp {
+ variable auto_index
+ array set auto_index {}
-interp alias {} ::incr0 {} incr
+ # the auto_index in ${tclpath}/tclIndex is loaded
+ # this array is used to fetch a list of Rivet commands
+ # implemented in Rivet
-## Initialize Rivet.
-::Rivet::init
+ set dir $tclpath
+ source [file join $tclpath tclIndex]
-## And now we get to the import of the whole ::rivet namespace.
+ # Rivet Tcl commands not meant to go onto the export list must
+ # be unset from auto_index here
-# Do we actually want to import everything? If Rivet was configured
-# to import the ::rivet namespace for compatibility we do it right away.
-# This option is not guaranteed to be supported in future versions.
+ unset auto_index(::rivet::catch)
+ unset auto_index(::rivet::try)
+ }
-if {[info exists module_conf(import_rivet_commands)] && $module_conf(import_rivet_commands)} {
+ set commands [namespace eval ::Rivet::temp {array names auto_index}]
- namespace eval :: { namespace import ::rivet::* }
+ # we won't leave anything behind
+ namespace delete ::Rivet::temp
+ return $commands
}
-array unset module_conf
+::Rivet::init
+package provide Rivet @INIT_VERSION@
---------------------------------------------------------------------
To unsubscribe, e-mail: site-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: site-cvs-help@tcl.apache.org