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]} {
      if {![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 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"
    }
    array unset ::xo::cleanup
    #ns_log notice "*** end of cleanup"

XQL Not present:

Generic, PostgreSQL, Oracle