rivet/init.tcl - tcl-rivet - Git at Google

 #
 # init.tcl --
 #
 #
 # Copyright 2002-2017 The Apache Rivet Team
 #
 # Licensed under the Apache License, Version 2.0 (the "License");
 # you may not use this file except in compliance with the License.
 # You may obtain a copy of the License at
 #
 #	http://www.apache.org/licenses/LICENSE-2.0
 #
 # Unless required by applicable law or agreed to in writing, software
 # distributed under the License is distributed on an "AS IS" BASIS,
 # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 # See the License for the specific language governing permissions and
 # limitations under the License.

 package require rivetlib 3.2

 # the ::rivet namespace is created in mod_rivet_commoc.c:Rivet_PerInterpInit
 # namespace eval ::rivet {} ; ## create namespace
 namespace eval ::Rivet {} ; ## create namespace

 ## ::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::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]

     ## 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} .

     ## As we moved the command set to the ::rivet namespace we
     ## still want to guarantee the commands to be 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.

     if {[string is true -strict [::rivet::inspect ExportRivetNS]]
         || [string is true -strict [::rivet::inspect ImportRivetNS]]} {

         set ::rivet::cmd_export_list \
             [tcl_commands_export_list $::Rivet::rivet_tcl]

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

             namespace export {*}$export_list
         }
     }

     ## If we are running from within mod_rivet we have already
     ## defined ::rivet::exit (mod_rivet_common.c: Rivet_PerInterpInit)
     ## and we move Tcl's exit command out of the way and replace it with
     ## our own that handles bailing from a page request properly.

     if {[info commands ::rivet::exit] != ""} {

         rename ::exit ::Rivet::tclcore_exit
         proc ::exit {code} {
             if {![string is integer -strict $code]} { set code 0 }
             ::rivet::exit $code
         }

     }

     ## If Rivet was configured for backward compatibility, import commands
     ## from the ::rivet namespace into the global namespace.
     if {[string is true -strict [::rivet::inspect ImportRivetNS]]} {
         uplevel #0 { namespace import ::rivet::* }
     }
     #unset -nocomplain ::module_conf
 }

 ###
 ## This routine gets called each time a new request comes in.
 ## It sets up the request namespace and creates a global command
 ## to replace the default global.  This ensures that when a user
 ## uses global variables, they're actually contained within the
 ## namespace.  So, everything gets deleted when the request is finished.
 ###
 proc ::Rivet::initialize_request {} {
     catch { namespace delete ::request }

     namespace eval ::request {}

     proc ::request::global {args} {
         foreach arg $args {
             uplevel "::global ::request::$arg"
         }
     }
 }

 ## ::Rivet::handle_error
 ##
 ## 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>"
 }

 ## ::Rivet::request_handling
 ##
 ## 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 {} {
     ::try {
         uplevel #0 ::Rivet::initialize_request
     } on error {err} {
         ::rivet::apache_log_error crit \
             "Rivet request initialization failed: $::errorInfo"
     }

     ::try {
         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
             namespace eval ::request $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 {
         ::Rivet::finish_request $script "" "" AfterEveryScript
     }

 }

 ## ::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_error err \
                 "Rivet $scriptName failed: $::errorInfo"
             print_error_message "Rivet $scriptName failed"
         }
     }

     set error_script [::rivet::inspect ErrorScript]
     if {$error_script eq ""} {
         set ::errorOutbuf $script ; ## legacy variable
         set error_script ::Rivet::handle_error
     }

     ::try {
         set ::Rivet::script $script
         uplevel #0 $error_script
     } on error {err} {
         ::rivet::apache_log_error err "Rivet ErrorScript failed: $::errorInfo"
         print_error_message "Rivet ErrorScript failed"
     }
 }

 ## ::Rivet::print_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} {
     puts "<strong>$error_header</strong><br/><pre>$::errorInfo</pre>"
 }

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

     namespace eval ::Rivet::temp {
         variable auto_index
         array set auto_index {}

         # the auto_index in ${tclpath}/tclIndex is loaded
         # this array is used to fetch a list of Rivet commands
         # implemented in Rivet

         set dir $tclpath
         source [file join $tclpath tclIndex]

         # Rivet Tcl commands not meant to go onto the export list must
         # be unset from auto_index here

         unset auto_index(::rivet::catch)
         unset auto_index(::rivet::try)
     }

     set commands [namespace eval ::Rivet::temp {array names auto_index}]

     # we won't leave anything behind
     namespace delete ::Rivet::temp

     return $commands
 }

 ::Rivet::init

 package provide Rivet 3.2
	#
	# init.tcl --
	#
	#
	# Copyright 2002-2017 The Apache Rivet Team
	#
	# Licensed under the Apache License, Version 2.0 (the "License");
	# you may not use this file except in compliance with the License.
	# You may obtain a copy of the License at
	#
	# http://www.apache.org/licenses/LICENSE-2.0
	#
	# Unless required by applicable law or agreed to in writing, software
	# distributed under the License is distributed on an "AS IS" BASIS,
	# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
	# See the License for the specific language governing permissions and
	# limitations under the License.

	package require rivetlib 3.2

	# the ::rivet namespace is created in mod_rivet_commoc.c:Rivet_PerInterpInit
	# namespace eval ::rivet {} ; ## create namespace
	namespace eval ::Rivet {} ; ## create namespace

	## ::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::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]

	## 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} .

	## As we moved the command set to the ::rivet namespace we
	## still want to guarantee the commands to be 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.

	if {[string is true -strict [::rivet::inspect ExportRivetNS]]
	\|\| [string is true -strict [::rivet::inspect ImportRivetNS]]} {

	set ::rivet::cmd_export_list \
	[tcl_commands_export_list $::Rivet::rivet_tcl]

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

	namespace export {*}$export_list
	}
	}

	## If we are running from within mod_rivet we have already
	## defined ::rivet::exit (mod_rivet_common.c: Rivet_PerInterpInit)
	## and we move Tcl's exit command out of the way and replace it with
	## our own that handles bailing from a page request properly.

	if {[info commands ::rivet::exit] != ""} {

	rename ::exit ::Rivet::tclcore_exit
	proc ::exit {code} {
	if {![string is integer -strict $code]} { set code 0 }
	::rivet::exit $code
	}

	}

	## If Rivet was configured for backward compatibility, import commands
	## from the ::rivet namespace into the global namespace.
	if {[string is true -strict [::rivet::inspect ImportRivetNS]]} {
	uplevel #0 { namespace import ::rivet::* }
	}
	#unset -nocomplain ::module_conf
	}

	###
	## This routine gets called each time a new request comes in.
	## It sets up the request namespace and creates a global command
	## to replace the default global. This ensures that when a user
	## uses global variables, they're actually contained within the
	## namespace. So, everything gets deleted when the request is finished.
	###
	proc ::Rivet::initialize_request {} {
	catch { namespace delete ::request }

	namespace eval ::request {}

	proc ::request::global {args} {
	foreach arg $args {
	uplevel "::global ::request::$arg"
	}
	}
	}

	## ::Rivet::handle_error
	##
	## 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>"
	}

	## ::Rivet::request_handling
	##
	## 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 {} {
	::try {
	uplevel #0 ::Rivet::initialize_request
	} on error {err} {
	::rivet::apache_log_error crit \
	"Rivet request initialization failed: $::errorInfo"
	}

	::try {
	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
	namespace eval ::request $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 {
	::Rivet::finish_request $script "" "" AfterEveryScript
	}

	}

	## ::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_error err \
	"Rivet $scriptName failed: $::errorInfo"
	print_error_message "Rivet $scriptName failed"
	}
	}

	set error_script [::rivet::inspect ErrorScript]
	if {$error_script eq ""} {
	set ::errorOutbuf $script ; ## legacy variable
	set error_script ::Rivet::handle_error
	}

	::try {
	set ::Rivet::script $script
	uplevel #0 $error_script
	} on error {err} {
	::rivet::apache_log_error err "Rivet ErrorScript failed: $::errorInfo"
	print_error_message "Rivet ErrorScript failed"
	}
	}

	## ::Rivet::print_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} {
	puts "<strong>$error_header</strong><br/><pre>$::errorInfo</pre>"
	}

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

	namespace eval ::Rivet::temp {
	variable auto_index
	array set auto_index {}

	# the auto_index in ${tclpath}/tclIndex is loaded
	# this array is used to fetch a list of Rivet commands
	# implemented in Rivet

	set dir $tclpath
	source [file join $tclpath tclIndex]

	# Rivet Tcl commands not meant to go onto the export list must
	# be unset from auto_index here

	unset auto_index(::rivet::catch)
	unset auto_index(::rivet::try)
	}

	set commands [namespace eval ::Rivet::temp {array names auto_index}]

	# we won't leave anything behind
	namespace delete ::Rivet::temp

	return $commands
	}

	::Rivet::init

	package provide Rivet 3.2