xo::library doc { Generic chat procs @creation-date 2006-02-02 @author Gustaf Neumann @cvs-id $Id: chat-procs.tcl,v 1.33 2018/09/19 16:19:16 antoniop Exp $ } namespace eval ::xo { Class create Message -parameter {time user_id msg color} Class create Chat -superclass ::xo::OrderedComposite \ -parameter { chat_id user_id session_id {mode default} {encoder noencode} {timewindow 600} {sweepinterval 599} {login_messages_p t} {logout_messages_p t} } Chat instproc init {} { # :log "-- " set :now [clock clicks -milliseconds] if {![info exists :user_id]} { set :user_id [ad_conn user_id] } if {![info exists :session_id]} { set :session_id [ad_conn session_id] } set cls [:info class] set :array $cls-${:chat_id} if {![nsv_exists $cls initialized]} { :log "-- initialize $cls" $cls initialize_nsvs ::xo::clusterwide nsv_set $cls initialized \ [ad_schedule_proc \ -thread "t" [:sweepinterval] $cls sweep_all_chats] } if {![nsv_exists ${:array}-seen newest]} { ::xo::clusterwide nsv_set ${:array}-seen newest 0 } if {![nsv_exists ${:array}-color idx]} { ::xo::clusterwide nsv_set ${:array}-color idx 0 } if {[:user_id] != 0 || [:session_id] != 0} { :init_user_color } } Chat instproc register_nsvs {msg_id user_id msg color secs} { # Tell the system we are back again, in case we were auto logged out if { ![nsv_exists ${:array}-login $user_id] } { ::xo::clusterwide nsv_set ${:array}-login $user_id [clock seconds] } ::xo::clusterwide nsv_set ${:array} $msg_id [list ${:now} $secs $user_id $msg $color] ::xo::clusterwide nsv_set ${:array}-seen newest ${:now} ::xo::clusterwide nsv_set ${:array}-seen last $secs ::xo::clusterwide nsv_set ${:array}-last-activity $user_id ${:now} } Chat instproc add_msg {{-get_new:boolean true} {-uid ""} msg} { # :log "--chat adding $msg" set user_id [expr {$uid ne "" ? $uid : ${:user_id}}] set color [:user_color $user_id] set msg [ns_quotehtml $msg] # :log "-- msg=$msg" if {$get_new && [info commands ::thread::mutex] ne "" && [info commands ::bgdelivery] ne ""} { # we could use the streaming interface :broadcast_msg [Message new -volatile -time [clock seconds] \ -user_id $user_id -color $color [list -msg $msg]] } :register_nsvs ${:now}.$user_id $user_id $msg $color [clock seconds] # this in any case a valid result, but only needed for the polling interface if {$get_new} {my get_new} } Chat instproc current_message_valid {} { expr { [info exists :user_id] && ${:user_id} != -1 } } Chat instproc active_user_list {} { nsv_array get ${:array}-login } Chat instproc nr_active_users {} { expr { [llength [nsv_array get ${:array}-login]] / 2 } } Chat instproc last_activity {} { if { ![nsv_exists ${:array}-seen last] } { return "-" } return [clock format [nsv_get ${:array}-seen last] -format "%d.%m.%y %H:%M:%S"] } Chat instproc check_age {key ago} { if {$ago > ${:timewindow}} { ::xo::clusterwide nsv_unset ${:array} $key #my log "--c unsetting $key" return 0 } return 1 } Chat instproc get_new {} { set last [expr {[nsv_exists ${:array}-seen ${:session_id}] ? [nsv_get ${:array}-seen ${:session_id}] : 0}] if {[nsv_get ${:array}-seen newest]>$last} { #my log "--c must check ${:session_id}: [nsv_get ${:array}-seen newest] > $last" foreach {key value} [nsv_array get ${:array}] { lassign $value timestamp secs user msg color if {$timestamp > $last} { # # add the message to the ordered composite. # :add [Message new -time $secs -user_id $user -msg $msg -color $color] } else { :check_age $key [expr {(${:now} - $timestamp) / 1000}] } } ::xo::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now} #my log "--c setting session_id ${:session_id}: ${:now}" } else { #my log "--c nothing new for ${:session_id}" } :render } Chat instproc get_all {} { foreach {key value} [nsv_array get ${:array}] { lassign $value timestamp secs user msg color if {[:check_age $key [expr {(${:now} - $timestamp) / 1000}]]} { :add [Message new -time $secs -user_id $user -msg $msg -color $color] } } #my log "--c setting session_id ${:session_id}: ${:now}" ::xo::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now} :render } Chat instproc sweeper {} { :log "--core-chat starting" foreach {user timestamp} [nsv_array get ${:array}-last-activity] { ns_log Notice "--core-chat at user $user with $timestamp" set ago [expr {(${:now} - $timestamp) / 1000}] ns_log Notice "--core-chat Checking: now=${:now}, timestamp=$timestamp, ago=$ago" # was 1200 if {$ago > 300} { :logout -user_id $user -msg "auto logout" try {::bgdelivery do ::Subscriber sweep chat-[:chat_id]} } } :log "-- ending" } Chat instproc logout {{-user_id ""} {-msg ""}} { set user_id [expr {$user_id ne "" ? $user_id : ${:user_id}}] ns_log Notice "--core-chat User $user_id logging out of chat" if {${:logout_messages_p}} { if {$msg eq ""} {set msg [_ chat.has_left_the_room].} :add_msg -get_new false $msg } # These values could already not be here. Just ignore when we don't # find them try { ::xo::clusterwide nsv_unset -nocomplain ${:array}-login $user_id } try { ::xo::clusterwide nsv_unset -nocomplain ${:array}-color $user_id } try { ::xo::clusterwide nsv_unset -nocomplain ${:array}-last-activity $user_id } } Chat instproc init_user_color {} { if { [nsv_exists ${:array}-color ${:user_id}] } { return } else { set colors [::xo::parameter get -parameter UserColors -default [[:info class] set colors]] # ns_log notice "getting colors of [:info class] = [info exists colors]" set color [lindex $colors [expr { [nsv_get ${:array}-color idx] % [llength $colors] }]] ::xo::clusterwide nsv_set ${:array}-color ${:user_id} $color ::xo::clusterwide nsv_incr ${:array}-color idx } } Chat instproc get_users {} { set output "" foreach {user_id timestamp} [:active_user_list] { if {$user_id > 0} { set diff [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1] set userlink [:user_link -user_id $user_id] append output "