ad_page_contract { Displays last n lines of long-calls log @author Gustaf Neumann @cvs-id $Id: long-calls.tcl,v 1.4.2.11 2022/11/24 19:26:45 gustafn Exp $ } -query { {lines:naturalnum 20} {readsize:naturalnum 100000} {pool:word,multiple ""} } -properties { title:onevalue context:onevalue } proc ::xo::userid_link {uid} { if {![string is integer -strict $uid]} { set userinfo 0 } else { set user_info [xo::request_monitor_user_info $uid] set user_url [dict get $user_info url] set userinfo "$uid" } return $userinfo } proc ::xo::regsub_eval {re string cmd {prefix ""}} { set map { \" \\\" \[ \\[ \] \\] \$ \\$ \\ \\\\} return [uplevel [list subst [regsub -all -- $re [string map $map $string] "\[$cmd\]"]]] } proc ::xo::subst_user_link {prefix uid} { return $prefix[::xo::userid_link $uid] } nsf::proc ::xo::colorize_slow_calls {-fast:required -warning:required -danger:required value} { if {$value > $danger} { return "danger bg-danger bg-opacity-10" } elseif {$value > $warning} { return "warning bg-warning bg-opacity-10" } elseif {$value > $fast} { return "info bg-info bg-opacity-10" } else { return "success bg-success bg-opacity-10" } } set long_calls_file [file dirname [ns_info log]]/long-calls.log set filesize [ad_file size $long_calls_file] set F [open $long_calls_file] if {$readsize < $filesize} { seek $F -$readsize end } set c [read $F]; close $F set offsets [regexp -indices -all -inline \n $c] set offset [lindex $offsets end-$lines 0] if {$offset eq ""} { # # Trim potential partial lines # set offset [lindex $offsets 0 0] } set c1 [string range $c $offset+1 end] set logLines [lreverse [split $c1 \n]] # # Determine the pools which where used in line range of the log lines, # that we are looking at? # set foundPoolsDict "" foreach line $logLines { if {$line eq ""} continue dict set foundPoolsDict [lindex $line 12] 1 } # # Remember pool settings for the number-of-lines filter # set filterQuery &[export_vars {pool:multiple}] # # Map in the found pools empty to "default" # set foundPools [lmap p [lsort [dict keys $foundPoolsDict]] { expr {$p eq "" ? "default" : $p} }] # # In case, no "pool" filter value was provided, show all found pools. # if {$pool eq ""} { set pool $foundPools set filterQuery "" } set inputPools $pool # # Create a multirow to let templating make some work # template::multirow create poolcheckboxes name checked foreach name $foundPools { template::multirow append poolcheckboxes $name [expr {$name in $inputPools ? "checked" : ""}] } # # Provide the reverse mapping for "default" to "" avoid doing the test # in the loop. # set pools [lmap p $inputPools {expr {$p eq "default" ? "" : $p}}] set rows "" foreach line $logLines { if {$line eq ""} continue lassign $line wday mon day hours tz year dash url time uid ip contentType pool if {$pool ni $pools} { continue } set userinfo [::xo::userid_link $uid] set iplink [subst {[ns_quotehtml $ip]}] if {[llength $time] > 1} { set queuetime [dict get $time queuetime] set filtertime [dict get $time filtertime] set runtime [dict get $time runtime] if {[dict exists $time start]} { set s0 [dict get $time start] set start_secs [ns_time seconds $s0] set start_msecs [string range [ns_time format $s0] end-6 end] set start [clock format $start_secs -format %H:%M:%S]$start_msecs } else { set start "" } set totaltime [format %8.6f [expr {$queuetime + $filtertime + $runtime}]] set color(queuetime) [::xo::colorize_slow_calls -fast 0.001 -warning 0.50 -danger 1.00 $queuetime] set color(filtertime) [::xo::colorize_slow_calls -fast 0.010 -warning 1.00 -danger 2.00 $filtertime] set color(runtime) [::xo::colorize_slow_calls -fast 0.010 -warning 5.00 -danger 10.00 $runtime] set color(totaltime) [::xo::colorize_slow_calls -fast 0.010 -warning 5.00 -danger 10.00 $totaltime] set color(start) "small info bg-info bg-opacity-10" } else { lassign {"" "" "" ""} start queuetime filtertime runtime lassign {"" "" "" ""} color(start) color(queuetime) color(filtertime) color(runtime) set totaltime $time set color(totaltime) [::xo::colorize_slow_calls -fast 0.010 -warning 3.00 -danger 10.00 $totaltime] } if {$time < 6000} { set class info } elseif {$time < 10000} { set class warning } else { set class danger } set request [ns_quotehtml $url] set request [::xo::regsub_eval {user_id=([0-9]+)} $request {::xo::subst_user_link user_id= \1} user_id=] append rows "