stat-details.tcl

Does not contain a contract.

Location:
/packages/acs-subsite/www/admin/system/stat-details.tcl
File Contents

set stat [throttleThread do throttle report_url_stats]
set fmt  "%-75s|%14d|%7d|%10.0f|%8.2f%%\n"
set fmtn "%-75s|%14s|%7s|%10s|%9s<br>"
set report "<font size='-2'><pre>"
append report [format $fmtn "" total cnt avg percent]

Class aggr_manager -parameter { debug_output }
Class aggr_pattern -parameter { name pattern set_match_var }
Class aggr_data -parameter { {all_urls {}} {total 0} {cnt 0} {aggregated 0}}

aggr_data instproc name {} {
    :instvar aggregated all_urls
    set parent_obj [[:info parent] info parent]
    set name [namespace tail [self]]
    if { [$parent_obj debug_output] == 1 } { set debug "(DEBUG: $all_urls)" } else { set debug "" }
    if { $aggregated } { set name "AGG: $name $debug" }
    return $name
}

aggr_manager instproc init {} {
    collection create [self]::patterns
    collection create [self]::data
    aggr_pattern create [self]::patterns::01 -name "Community" \
        -pattern {/dotlrn/classes/[[:alnum:]\-_]+/$} -set_match_var 0
    aggr_pattern create [self]::patterns::02 -name "Any URL under Class level" \
        -pattern {/dotlrn/classes/[[:alnum:]\-_]+/([[:alnum:]\-_/]+)$} -set_match_var 1
    aggr_pattern create [self]::patterns::03 -name "Community" \
        -pattern {/dotlrn/classes/[[:alnum:]\-_]+/[0-9]{4}\.[0-9]{2}[w|s]{1}[/]?$} -set_match_var 0
    aggr_pattern create [self]::patterns::04 -name "ANY URL under Class-Instance level" \
        -pattern {/dotlrn/classes/[[:alnum:]\-_]+/[0-9]{4}\.[0-9]{2}[w|s]{1}/([[:alpha:]\-_/]+)} -set_match_var 1
    aggr_pattern create [self]::patterns::05 -name "Downloads" \
        -pattern {/tlf-basic/download/} -set_match_var 0
}

aggr_manager instproc process_stats { stats } {
    foreach l $stats {
        set url [lindex $l 0]
        set total [lindex $l 1]
        set cnt [lindex $l 2]
        set found_agg 0
        foreach p [[self]::patterns] {
            if { [$p set_match_var] } {
                set m [regexp [$p pattern] $url _ match]
                #set name $match
            } else {
                set m [regexp [$p pattern] $url]
                #set name [$p pattern]
            }
            if { $m == 1 } {
                ns_log Notice "PATTERN [$p pattern] matching for URL $url"
                if { [info exists match] } {
                    set name $match
                    unset match
                } else {
                    set name [$p name]
                }
                set obj "[self]::data::$name"
                if { ![Object isobject $obj] } {
                    ns_log Notice "Creating Object $obj"
                    aggr_data create $obj -aggregated 1
                }
                ns_log Notice "AGGREGATING OBJ $obj" 
                $obj incr total $total
                $obj incr cnt $cnt
                $obj lappend all_urls $url
                set found_agg 1
            } 
        }
        if { $found_agg == 0 } {
            set obj [aggr_data create [self]::data::$url]
            $obj set total $total
            $obj set cnt $cnt
        }
    }
    set output [list]
    foreach data_obj [[self]::data] {
        lappend output [list [$data_obj name] [$data_obj total] [$data_obj cnt]]
    }
    return $output
}

aggr_manager create ::stats -debug_output 0
set stat [::stats process_stats $stat]

set total 0.0
set cnt 0
foreach l $stat {
  set total [expr {$total+[lindex $l 1]}]
  set cnt   [expr {$cnt  +[lindex $l 2]}]
}
set total_avg [expr {$total/($cnt*1000.0)}]
array set color {
   red {<div style='color: red'>}
   orange {<div style='color: purple'>}
   yellow {<div style='color: maroon'>}
   green {<div style='color: green'>}
   ok {}
}

foreach l [lsort -real -decreasing -index 1 $stat] {
  set avg [expr {[lindex $l 1]/[lindex $l 2]}]
  set rel [expr {($avg/1000.0)/$total_avg}]
  if {$rel > 3} {set code red} \
  elseif {$rel > 2} {set code orange} \
  elseif {$rel > 1} {set code yellow} \
  elseif {$rel < 0.5} {set code green} \
  else {set code ok}
  if {$color($code) ne "" } {
    set endtag </div>
  } else {
    set endtag ""
  }
  append report $color($code) [format $fmt \
           [lindex $l 0] [lindex $l 1] [lindex $l 2] \
           $avg \
           [expr {[lindex $l 1]*100.0/$total}] \
                ] $endtag 
}
append text "<p><br><p><b>Grand Total Avg Response time: </b>" \
    [format %6.2f $total_avg] " seconds/call " \
    "(base: $cnt dynamic content requests $total)<p>"
append text $report </pre></font><p>

ad_return_template
stat-details.tcl

Related Files

File Contents
