Index: openacs-4/packages/xotcl-core/tcl/chat-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/Attic/chat-procs.tcl,v diff -u -r1.23 -r1.24 --- openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 16 Jun 2015 20:35:32 -0000 1.23 +++ openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 7 Aug 2017 23:48:30 -0000 1.24 @@ -3,38 +3,49 @@ @creation-date 2006-02-02 @author Gustaf Neumann - @cvs-id $Id$ + @cvs-id $Id$ } namespace eval ::xo { - Class Message -parameter {time user_id msg color} - Class Chat -superclass ::xo::OrderedComposite \ + Class create Message -parameter {time user_id msg color} + Class create Chat -superclass ::xo::OrderedComposite \ -parameter { - chat_id - user_id - session_id + chat_id + user_id + session_id {mode default} - {encoder urlencode} - {timewindow 600} + {encoder noencode} + {timewindow 600} {sweepinterval 599} + {login_messages_p t} + {logout_messages_p t} } Chat instproc init {} { my instvar array # my log "-- " my set now [clock clicks -milliseconds] - if {![my exists user_id]} {my set user_id [ad_conn user_id]} - if {![my exists session_id]} {my set session_id [ad_conn session_id]} + if {![my exists user_id]} { + my set user_id [ad_conn user_id] + } + if {![my exists session_id]} { + my set session_id [ad_conn session_id] + } set cls [my info class] set array $cls-[my set chat_id] if {![nsv_exists $cls initialized]} { my log "-- initialize $cls" $cls initialize_nsvs ::xo::clusterwide nsv_set $cls initialized \ - [ad_schedule_proc -thread "t" [my sweepinterval] $cls sweep_all_chats] + [ad_schedule_proc \ + -thread "t" [my 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 {![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 {[my user_id] != 0 || [my session_id] != 0} { my init_user_color } @@ -44,29 +55,30 @@ Chat instproc register_nsvs {msg_id user_id msg color secs} { my instvar array now + # 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 $secs + ::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} { - my log "--chat adding $msg" + Chat instproc add_msg {{-get_new:boolean true} {-uid ""} msg} { + # my log "--chat adding $msg" my instvar array now - set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] + set user_id [expr {$uid ne "" ? $uid : [my set user_id]}] set color [my user_color $user_id] - set msg [ad_quotehtml $msg] - my log "-- msg=$msg" - - if {$get_new - && [info commands ::thread::mutex] ne "" - && [info commands ::bgdelivery] ne ""} { + set msg [ns_quotehtml $msg] + # my log "-- msg=$msg" + + if {$get_new + && [info commands ::thread::mutex] ne "" + && [info commands ::bgdelivery] ne ""} { # we could use the streaming interface my broadcast_msg [Message new -volatile -time [clock seconds] \ - -user_id $user_id -msg $msg -color $color] + -user_id $user_id -color $color [list -msg $msg]] } my 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 @@ -76,20 +88,20 @@ Chat instproc current_message_valid {} { expr { [my exists user_id] && [my set user_id] != -1 } } - + Chat instproc active_user_list {} { nsv_array get [my set array]-login } - + Chat instproc nr_active_users {} { expr { [llength [nsv_array get [my set array]-login]] / 2 } } - + Chat instproc last_activity {} { if { ![nsv_exists [my set array]-seen last] } { return "-" } return [clock format [nsv_get [my set array]-seen last] -format "%d.%m.%y %H:%M:%S"] } - + Chat instproc check_age {key ago} { my instvar array timewindow if {$ago > $timewindow} { @@ -108,6 +120,9 @@ foreach {key value} [nsv_array get $array] { lassign $value timestamp secs user msg color if {$timestamp > $last} { + # + # add the message to the ordered composite. + # my add [Message new -time $secs -user_id $user -msg $msg -color $color] } else { my check_age $key [expr {($now - $timestamp) / 1000}] @@ -120,7 +135,7 @@ } my render } - + Chat instproc get_all {} { my instvar array now session_id foreach {key value} [nsv_array get $array] { @@ -135,35 +150,32 @@ } Chat instproc sweeper {} { - my instvar array now + my instvar array now logout_messages_p my 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} { - my add_msg -get_new false -uid $user "auto logout" - nsv_unset $array-last-activity $user - nsv_unset $array-login $user - nsv_unset $array-color $user + if {$ago > 300} { + my logout -user_id $user -msg "auto logout" catch {::bgdelivery do ::Subscriber sweep chat-[my chat_id]} } } my log "-- ending" } - Chat instproc logout {} { - my instvar array user_id + Chat instproc logout {{-user_id ""} {-msg ""}} { + set user_id [expr {$user_id ne "" ? $user_id : [my set user_id]}] ns_log Notice "--core-chat User $user_id logging out of chat" - my add_msg -get_new false [_ chat.has_left_the_room]. - catch { - # do not try to clear nsvs, if they are not available - # this situation could occur after a server restart, after which the user tries to leave the room - ::xo::clusterwide nsv_unset $array-last-activity $user_id - ::xo::clusterwide nsv_unset $array-login $user_id - ::xo::clusterwide nsv_unset $array-color $user_id + if {[my set logout_messages_p]} { + if {$msg eq ""} {set msg [_ chat.has_left_the_room].} + my add_msg -get_new false $msg } + my instvar array + ::xo::clusterwide nsv_unset -nocomplain $array-login $user_id + ::xo::clusterwide nsv_unset -nocomplain $array-color $user_id + ::xo::clusterwide nsv_unset -nocomplain $array-last-activity $user_id } Chat instproc init_user_color {} { @@ -178,7 +190,7 @@ ::xo::clusterwide nsv_incr $array-color idx } } - + Chat instproc get_users {} { set output "" foreach {user_id timestamp} [my active_user_list] { @@ -187,10 +199,10 @@ set userlink [my user_link -user_id $user_id] append output "$userlink$diff\n" } - } + } return $output } - + Chat instproc user_active {user_id} { my instvar array # was the user already active? @@ -200,15 +212,20 @@ Chat instproc login {} { my log "--chat login" - my instvar user_id - if {![my user_active $user_id]} { + my instvar array user_id now + if {[my set login_messages_p] && ![my user_active $user_id]} { my add_msg -get_new false [_ xotcl-core.has_entered_the_room] + } elseif {![nsv_exists $array-login $user_id]} { + # give some proof of our presence to the chat system when we + # don't issue the login message + ::xo::clusterwide nsv_set $array-login $user_id [clock seconds] + ::xo::clusterwide nsv_set $array-last-activity $user_id $now } my encoder noencode - #my log "--c setting session_id [my set session_id]: [my set now]" + my log "--c setting session_id [my set session_id]: $now" return [my get_all] } - + Chat instproc user_color { user_id } { my instvar array if { ![nsv_exists $array-color $user_id] } { @@ -222,7 +239,7 @@ acs_user::get -user_id $user_id -array user return [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] } - + Chat instproc user_link { -user_id -color } { if {$user_id > 0} { set name [my user_name $user_id] @@ -235,17 +252,17 @@ set creator "Nobody" } else { set creator "System" - } - return [my encode $creator] + } + return [my encode $creator] } - + Chat instproc urlencode {string} {ns_urlencode $string} Chat instproc noencode {string} {set string} Chat instproc encode {string} {my [my encoder] $string} Chat instproc json_encode {string} { - string map [list \n \\n {"} {\"} ' {\'}] $string" + string map [list \n \\n \" \\\" ' {\'}] $string } - + Chat instproc json_encode_msg {msg} { set old [my encoder] my encoder noencode ;# just for user_link @@ -257,91 +274,91 @@ return [subst -nocommands {{'messages': [ {'user':'$userlink', 'time': '$timeshort', 'msg':'$text'} ]\n} - }] - } + }] + } - Chat instproc js_encode_msg {msg} { - set json [my json_encode_msg $msg] - return "\n" - } + } - Chat instproc broadcast_msg {msg} { - my log "--chat broadcast_msg $msg" - ::xo::clusterwide \ - bgdelivery send_to_subscriber chat-[my chat_id] [my json_encode_msg $msg] - } + Chat instproc broadcast_msg {msg} { + my log "--chat broadcast_msg" + ::xo::clusterwide \ + bgdelivery send_to_subscriber chat-[my chat_id] [my json_encode_msg $msg] + } - Chat instproc subscribe {-uid} { - set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] - set color [my user_color $user_id] - bgdelivery subscribe chat-[my chat_id] "" [my mode] - if {![my user_active $user_id]} { - my broadcast_msg [Message new -volatile -time [clock seconds] \ - -user_id $user_id -color $color \ - -msg [_ xotcl-core.has_entered_the_room] ] - } - #my get_all - } - - Chat instproc render {} { - my orderby time - set result "
\n" - foreach child [my children] { - set msg [$child msg] - set user_id [$child user_id] - set color [$child color] - set timelong [clock format [$child time]] - set timeshort [clock format [$child time] -format {[%H:%M:%S]}] - set userlink [my user_link -user_id $user_id -color $color] - - append result "

$timeshort " \ + Chat instproc subscribe {-uid} { + set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] + set color [my user_color $user_id] + bgdelivery subscribe chat-[my chat_id] "" [my mode] + if {[my set login_messages_p] && ![my user_active $user_id]} { + my broadcast_msg [Message new -volatile -time [clock seconds] \ + -user_id $user_id -color $color \ + -msg [_ xotcl-core.has_entered_the_room] ] + } + #my get_all + } + + Chat instproc render {} { + my orderby time + set result "

\n" + foreach child [my children] { + set msg [$child msg] + set user_id [$child user_id] + set color [$child color] + set timelong [clock format [$child time]] + set timeshort [clock format [$child time] -format {[%H:%M:%S]}] + set userlink [my user_link -user_id $user_id -color $color] + ns_log notice "encode <$msg> using encoder [my encoder] gives <[my encode $msg]>" + append result "

$timeshort " \ "$userlink " \ "[my encode $msg]

\n" - } - append result "
" - return $result - } + } + append result "
" + return $result + } - ############################################################################ - # Chat meta class, since we need to define general class-specific methods - ############################################################################ - Class create ChatClass -superclass ::xotcl::Class - ChatClass method sweep_all_chats {} { - my log "-- starting" - foreach nsv [nsv_names "[self]-*-seen"] { - if { [regexp "[self]-(\[0-9\]+)-seen" $nsv _ chat_id] } { - my log "--Chat_id $chat_id" - my new -volatile -chat_id $chat_id -user_id 0 -session_id 0 -init -sweeper - } - } - my log "-- ending" - } - - ChatClass method initialize_nsvs {} { - # read the last_activity information at server start into a nsv array - ::xo::dc foreach get_rooms { - select room_id, to_char(max(creation_date),'HH24:MI:SS YYYY-MM-DD') as last_activity - from chat_msgs group by room_id - } { - ::xo::clusterwide nsv_set [self]-$room_id-seen last [clock scan $last_activity] - } - } - - ChatClass method flush_messages {-chat_id:required} { - set array "[self]-$chat_id" - ::xo::clusterwide nsv_unset $array - ::xo::clusterwide nsv_unset $array-seen - ::xo::clusterwide nsv_unset $array-last-activity - } + ############################################################################ + # Chat meta class, since we need to define general class-specific methods + ############################################################################ + Class create ChatClass -superclass ::xotcl::Class + ChatClass method sweep_all_chats {} { + my log "-- starting" + foreach nsv [nsv_names "[self]-*-seen"] { + if { [regexp "[self]-(\[0-9\]+)-seen" $nsv _ chat_id] } { + my log "--Chat_id $chat_id" + my new -volatile -chat_id $chat_id -user_id 0 -session_id 0 -init -sweeper + } + } + my log "-- ending" + } - ChatClass method init {} { - # default setting is set19 from http://www.graphviz.org/doc/info/colors.html - # per parameter settings in the chat package are available (param UserColors) - my set colors [list #1b9e77 #d95f02 #7570b3 #e7298a #66a61e #e6ab02 #a6761d #666666] - } + ChatClass method initialize_nsvs {} { + # read the last_activity information at server start into a nsv array + ::xo::dc foreach get_rooms { + select room_id, to_char(max(creation_date),'HH24:MI:SS YYYY-MM-DD') as last_activity + from chat_msgs group by room_id + } { + ::xo::clusterwide nsv_set [self]-$room_id-seen last [clock scan $last_activity] + } + } + + ChatClass method flush_messages {-chat_id:required} { + set array "[self]-$chat_id" + ::xo::clusterwide nsv_unset -nocomplain $array + ::xo::clusterwide nsv_unset -nocomplain $array-seen + ::xo::clusterwide nsv_unset -nocomplain $array-last-activity + } + + ChatClass method init {} { + # default setting is set19 from http://www.graphviz.org/doc/info/colors.html + # per parameter settings in the chat package are available (param UserColors) + my set colors [list #1b9e77 #d95f02 #7570b3 #e7298a #66a61e #e6ab02 #a6761d #666666] + } } #