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]
+ }
}
#