Forum OpenACS Development: Re: Users who have requested a page in the last 10 min. ? (acs-core)
Updating the db and working with a util_memoiz is a fine idead, but we don't want to hit the db for every single request.
To let this work with clusters we would have to put this information in the db, for standalone servers this patch will work.
In case their is more interest to let it run on clusters too, we might just append the Body of
proc ad_get_online_user_ids
proc ad_remove_offline_users_from_last_hit
to check wether it's a standalone server (doing it with an nsv_set)or a cluster (query the db , using a util_memoize)
Patch:
Add to the bottom of the file
/web/server/acs-tcl/utilities-procs.tcl
The folowing two proc's:
proc ad_get_online_user_ids
#returns a tcl list with all user_id's from those users wich have requested a page in the last 10 min.
proc ad_remove_offline_users_from_last_hit
#will be called by a scheduled proc every 1 hour it removes old entrys from the nsv_set
ad_proc ad_remove_offline_users_from_last_hit {} {
Removing all user_id's from the last_hit (nsv_set) wich have a time Stamp older than 10 min.
} {
array set last_hit [nsv_array get last_hit]
set onliners_out [list]
set oldtime [expr [ns_time] - [ad_parameter LastVisitUpdateInterval "" 600]]
for {set search [array startsearch last_hit]} {[array anymore last_hit $search]} {} {
set user [array nextelement last_hit $search]
set time $last_hit($user)
if {$time<$oldtime} {
lappend onliners_out $user
}
}
array donesearch last_hit $search
for {set i 0 } { $i < [llength $onliners_out]} {incr i} {
nsv_unset last_hit [lindex $onliners_out $i]
}
}
ad_proc ad_get_online_user_ids {} {
This function returns a list of user_ids from users wich have requested a page
from this Server in the last 10 min
} {
array set last_hit [nsv_array get last_hit]
set onliners [list]
set oldtime [expr [ns_time] - [ad_parameter LastVisitUpdateInterval "" 600]]
for {set search [array startsearch last_hit]} {[array anymore last_hit $search]} {} {
set user [array nextelement last_hit $search]
set time $last_hit($user)
if {$time>$oldtime} {
lappend onliners $user
}
}
array donesearch last_hit $search
return $onliners
}
In file
/web/server/packages/acs-tcl/request-processor-procs.tcl
in function 'ad_proc -private rp_handler {}'
Line 712
add this lines
#log the hit for "whos-online"
set user_id [ad_conn user_id]
#ensure that the user has a user_id
if { $user_id != "0"} { nsv_set last_hit $user_id [ns_time] }
to update the nsv_set on every http request.
In file
/web/server/packages/acs-tcl/request-processor-init.tcl
at the beginning of function 'ad_after_server_initialization procs_register {'
insert the following lines
#schedule the proc to cleanup old entrys from the nsv_set last_hit
ns_schedule_proc -thread ad_remove_offline_users_from_last_hit 3600
Save changes and restart the server.
Here is a littel tcl/adp script to check wether every thing worked.
tcl:
multirow create onliners user_id
array set last_hit [nsv_array get last_hit]
multirow create onliners_all user_id time
for {set search [array startsearch last_hit]} {[array anymore last_hit $search]} {} {
set user [array nextelement last_hit $search]
set time $last_hit($user)
multirow append onliners_all $user $time
}
array donesearch last_hit $search
set user_ids [ad_get_online_user_ids]
for {set i 0} {$i < [llength $user_ids]} { incr i} {
multirow append onliners [lindex $user_ids $i]
}
ad_remove_offline_users_from_last_hit
ADP:
<master>
<property name ="title">Jabber</property>
<property name="context"></property>
All users in nsv_set
<ul>
<multiple name=onliners_all>
<li>USER_ID: @onliners_all.user_id@ TIME: @onliners_all.time@</LI>
</multiple>
</ul>
only online
<ul>
<multiple name=onliners>
<li>USER_ID: @onliners.user_id@ TIME: @onliners.user_id@</LI>
</multiple>
</ul>