File: catch.tcl

package info (click to toggle)
libapache2-mod-rivet 3.2.8-1
  • links: PTS
  • area: main
  • in suites: forky, sid
  • size: 6,392 kB
  • sloc: tcl: 9,156; xml: 8,617; ansic: 7,071; sh: 5,040; makefile: 223; sql: 91; lisp: 78
file content (32 lines) | stat: -rw-r--r-- 756 bytes parent folder | download | duplicates (5) 
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
 
# -- catch.tcl
#
# Wrapper of the core [catch] command that checks whether 
# an error condition is actually raised by [::rivet::abort_page]
# or [::rivet::exit]. In case the error is thrown again to allow
# the interpreter to interrupt and pass execution to AbortScript
#
# $Id: $
#

namespace eval ::rivet {

    proc catch {script args} {

        set catch_ret [uplevel [list ::catch $script {*}$args]]

        if {$catch_ret && [::rivet::abort_page -aborting]} {

            return -code error -errorcode {RIVET ABORTPAGE} "Page abort"

        } elseif {$catch_ret && [::rivet::abort_page -exiting]} {

            return -code error -errorcode {RIVET THREAD_EXIT} "Thread exit"

        } else {

            return $catch_ret

        }

    }
}