File: init.tcl.in

package info (click to toggle)
libapache2-mod-rivet 3.2.2-1
  • links: PTS
  • area: main
  • in suites: bookworm
  • size: 6,296 kB
  • sloc: xml: 8,554; tcl: 7,568; ansic: 7,094; sh: 5,017; makefile: 195; sql: 91; lisp: 78
file content (262 lines) | stat: -rw-r--r-- 8,887 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
#
# 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_PACKAGE@ @RIVETLIB_PACKAGE_VERSION@

# 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 @INIT_VERSION@