ad_run_scheduled_proc (private)

 ad_run_scheduled_proc proc_info

Defined in packages/acs-tcl/tcl/utilities-procs.tcl

Runs a scheduled procedure and updates monitoring information in the shared variables.

Parameters:

proc_info (required)

Partial Call Graph (max 5 caller/called nodes):

Testcases:

No testcase defined.

Source code:

    if {[ns_info name] eq "NaviServer"} {
        set proc_info [lindex $proc_info 0]
    }

    #
    # Grab information about the scheduled procedure.
    #
    lassign $proc_info thread once interval proc args time . debug
    set count 0

    ad_mutex_eval [nsv_get ad_procs mutex] {
        set procs [nsv_get ad_procs .]

        #
        # Find the entry in the shared variable by comparing at the first
        # five fields. Then delete this entry from the jobs. It might be
        # added again after this loop with a fresh count and timestamp,
        # when "once" is false.
        #
        # It would be much better to use e.g. a dict with some proper keys
        # instead.
        #
        for { set i 0 } { $i < [llength $procs] } { incr i } {
            set other_proc_info [lindex $procs $i]
            for { set j 0 } { $j < 5 } { incr j } {
                if { [lindex $proc_info $j] ne [lindex $other_proc_info $j] } {
                    break
                }
            }

            #
            # When the entry was found ($j == 5) get the "count" and
            # delete the entry.
            #
            if { $j == 5 } {
                set count [lindex $other_proc_info 6]
                set procs [lreplace $procs $i $i]
                break
            }
        }

        if { $once == "f" } {
            #
            # The proc will run again - add it again to the shared
            # variable (updating ns_time and incrementing the count).
            #
            lappend procs [list $thread $once $interval $proc $args [ns_time] [expr { $count + 1 }] $debug]
        }
        nsv_set ad_procs . $procs
    }

    ns_log notice "Running scheduled proc $proc {*}$args..."

    # Actually run the procedure.
    if {$proc ne ""} {
        $proc {*}$args
    }

    ns_log debug "Done running scheduled proc $proc."

    #
    # In case there are temporary XOTcl objects, clean these up to
    # avoid surprises in schedued threads about pre-existing objects.
    #
    if {[namespace which ::xo::at_cleanup] ne ""} {
        ::xo::at_cleanup
    }

XQL Not present:

PostgreSQL, Oracle

Generic XQL file:

packages/acs-tcl/tcl/utilities-procs.xql