xo::at_cleanup (public)
xo::at_cleanup [ args... ]
Defined in packages/xotcl-core/tcl/01-debug-procs.tcl
# # Per-request cleanup handler. The handler is as well called by # the xowiki-datasource and must be therefore public. #
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- xowiki_test_cases
Source code: # # The following block is a safety measure: When there is no cleanup # for ::xo::cc defined, the object will survive a request and many # things might go wrong. The test is quite cheap an can reduce # debugging time on some sites. # if {[nsf::is object ::xo::cc] && ![info exists ::xo::cleanup(::xo::cc)]} { ns_log notice [::xo::cc serialize] ns_log error "no cleanup for ::xo::cc registered" ::xo::cc destroy } ::xo::dc profile off ::xo::broadcast receive if {$::xo::rss} { # # The following code works just for Linux, since it depends on # the /proc filesystem and the order of values in the resulting # line. # if {[file readable /proc/[pid]/statm]} { set F [open /proc/[pid]/statm]; set c [read $F]; close $F lassign $c size rss shared set size [format %.2f [expr {$rss * 4.096 / 1048576}]] if {$::xo::rss != $size} { ns_log notice "=== RSS size change to: $size GB" set ::xo::rss $size } } } #ns_log notice "*** start of cleanup <$args> ([array get ::xo::cleanup])" set at_end "" foreach {name cmd} [list {*}[array get ::xo::cleanup] {*}[array get ::xo::cleanup_always]] { #::trace remove variable ::xotcl_cleanup($name) unset ::xo::cleanup if {![nsf::is object $name]} { #ns_log notice "--D $name already destroyed, nothing to do" continue } if {$name eq "::xo::cc"} { append at_end $cmd\n continue } #ns_log notice "*** cleanup $cmd" try { {*}$cmd } on error {errorMsg} { set obj [lindex $cmd 0] ns_log error "Error during ::xo::cleanup: $errorMsg $::errorInfo" try { ns_log notice "... analyze: cmd = $cmd" ns_log notice "... analyze: $obj is_object? [nsf::is object $obj]" ns_log notice "... analyze: class [$obj info class]" ns_log notice "... analyze: precedence [$obj ::nsf::methods::object::info::precedence]" ns_log notice "... analyze: methods [lsort [$obj info methods]]" # # In case, we want to destroy some objects, and the # destructor fails, make sure to destroy them even # then. Half-deleted zombies can produce harm. We reclass # the object to the base class and try again. # if {[lindex $cmd 1] eq "destroy"} { ns_log error "... forcing object destroy without application level destructors" if {[$obj isclass]} { $obj class ::xotcl::Class; $obj destroy } else { $obj class ::xotcl::Object; $obj destroy } } } } } #ns_log notice "*** at_end $at_end" try { {*}$at_end } on error {errorMsg} { ns_log Error "Error during ::xo::cleanup: $errorMsg $::errorInfo" } unset -nocomplain ::xo::cleanup #ns_log notice "*** end of cleanup"XQL Not present: Generic, PostgreSQL, Oracle