Index: openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl,v diff -u -r1.20 -r1.21 --- openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 26 Dec 2008 01:09:51 -0000 1.20 +++ openacs-4/packages/xotcl-request-monitor/tcl/throttle_mod-procs.tcl 29 Dec 2008 13:12:27 -0000 1.21 @@ -365,7 +365,7 @@ Counter user_count_day -timeoutMs [expr {60000*60}] -logging 1 user_count_day proc end {} { - foreach {auth ip} [throttle users perDay] break + foreach {auth ip} [throttle users nr_users_per_day] break set now [clock format [clock seconds]] # The counter logs its intrinsic value (c) anyhow, which are the # authenticated users. We also want to record the number of @@ -768,14 +768,22 @@ my log "+++ cannot decrement refcount for '$key' by $hitcount" } } - Users proc perDay {} { + Users proc nr_users_per_day {} { set ip 0; set auth 0 foreach i [my array names timestamp] { if {[string match *.* $i]} {incr ip} {incr auth} } return [list $ip $auth] } - + Users proc users_per_day {} { + my instvar timestamp + set ip [list]; set auth [list] + foreach i [array names timestamp] { + if {[string match *.* $i]} {lappend ip [list $i $timestamp($i)]} {lappend auth [list $i $timestamp($i)]} + } + return [list $ip $auth] + } + Users proc perDayCleanup {} { set secsPerDay [expr {3600*24}] foreach i [lsort [my array names timestamp]] { Index: openacs-4/packages/xotcl-request-monitor/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/index.tcl,v diff -u -r1.13 -r1.14 --- openacs-4/packages/xotcl-request-monitor/www/index.tcl 4 Oct 2008 19:26:51 -0000 1.13 +++ openacs-4/packages/xotcl-request-monitor/www/index.tcl 29 Dec 2008 13:12:28 -0000 1.14 @@ -268,7 +268,7 @@ set authUsers10 [lindex $active10 1] set activeIP10 [lindex $active10 0] set activeTotal10 [expr {$authUsers10 + $activeIP10}] -set active24 [throttle users perDay] +set active24 [throttle users nr_users_per_day] set authUsers24 [lindex $active24 1] set activeIP24 [lindex $active24 0] set activeTotal24 [expr {$authUsers24 + $activeIP24}] @@ -280,7 +280,7 @@ set active_community_string "" } -set active_user_string "$activeTotal10 users ($authUsers10 authenticated) $active_community_string active in last 10 minutes, $activeTotal24 ($authUsers24 authenticated) in last $::server_running" +set active_user_string "$activeTotal10 users ($authUsers10 authenticated) $active_community_string active in last 10 minutes, $activeTotal24 ($authUsers24 authenticated) in last $::server_running" set jsGraph [expr {!$jsGraph}] set toggle_graphics_url [export_vars -base [ad_conn url] {jsGraph}] set jsGraph [expr {!$jsGraph}] Index: openacs-4/packages/xotcl-request-monitor/www/whos-online-today.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/whos-online-today.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xotcl-request-monitor/www/whos-online-today.adp 29 Dec 2008 13:12:28 -0000 1.1 @@ -0,0 +1,7 @@ + +@title;noquote@ +@context;noquote@ + +
+@t1;noquote@ +
Index: openacs-4/packages/xotcl-request-monitor/www/whos-online-today.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-request-monitor/www/whos-online-today.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xotcl-request-monitor/www/whos-online-today.tcl 29 Dec 2008 13:12:29 -0000 1.1 @@ -0,0 +1,80 @@ +ad_page_contract { + Displays who was online today + + @author Gustaf Neumann + + @cvs-id $id: whos-online.tcl,v 1.1.1.1 2004/03/16 16:11:51 nsadmin exp $ +} -query { + {orderby:optional "date,desc"} + {all:optional 0} +} -properties { + title:onevalue + context:onevalue +} + +set title "Who was online today?" +set context [list "Who was online today"] + +set admin [acs_user::site_wide_admin_p] +#set admin 0 + +set label(0) "Authenticated only" +set tooltip(0) "Show authenticated users only" +set label(1) all +set tooltip(1) "Show all users" +set all [expr {!$all}] +set url [export_vars -base [ad_conn url] {all}] + +TableWidget t1 \ + -actions [subst { + Action new -label "$label($all)" -url $url -tooltip "$tooltip($all)" + }] \ + -columns [subst { + AnchorField name -label "User" -orderby name + Field date -label "Last Activity" -html { align right } \ + -orderby date + }] \ + -no_data "no registered online today" + + +set users [list] +foreach {ip auth} [throttle users users_per_day] break +if {$all} {set elements [concat $ip $auth]} {set elements $auth} + +foreach element $elements { + foreach {user_id timestamp} $element break + if {[string is integer $user_id]} { + acs_user::get -user_id $user_id -array user + set user_label "$user(last_name), $user(first_names)" + set user_url [acs_community_member_url -user_id $user_id] + } else { + # it was an IP address + set user_label $user_id + set user_url "" + } + + lappend users [list $user_label \ + $user_url \ + $timestamp \ + [clock format $timestamp] \ + ] +} + +switch -glob $orderby { + *,desc {set order -decreasing} + *,asc {set order -increasing} +} +switch -glob $orderby { + name,* {set index 0; set type -dictionary} + date,* {set index 2; set type -integer} +} + +foreach e [lsort $type $order -index $index $users] { + if {$admin} { + t1 add -name [lindex $e 0] \ + -name.href [lindex $e 1] \ + -date [lindex $e 3] \ + } +} + +set t1 [t1 asHTML]