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.12 -r1.13 --- openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 7 Jun 2007 09:19:51 -0000 1.12 +++ openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 7 Jun 2007 11:55:47 -0000 1.13 @@ -1,24 +1,21 @@ ad_library { generic chat - chat procs - - @author Gustaf Neumann and Pablo Mu�oz(pablomp@tid.es) - + + @creation-date 2006-02-02 + @author Gustaf Neumann + @cvs-id $Id$ } namespace eval ::xo { Class Message -parameter {time user_id msg color} Class Chat -superclass ::xo::OrderedComposite \ -parameter {chat_id user_id session_id {mode default} {encoder urlencode} {timewindow 600} {sweepinterval 600} - } - + } - Chat instproc init {} { - + 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]} @@ -34,81 +31,32 @@ if {![nsv_exists $array-color idx]} {nsv_set $array-color idx 0} my init_user_color } - - Chat instproc add_msg {{-get_new:boolean true} -uid msg} { - - my instvar array now user_id chat_id + my instvar array now + set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] + set color [my user_color $user_id] + set msg [ad_quotehtml $msg] + my log "-- msg=$msg" - if { $get_new eq "true" } { - - db_1row room_info { - select count(cr.room_id) as count - from chat_room_user_id as cr - where cr.room_id = :chat_id - and cr.user_id = :user_id - } - - if { $count == 1 || [permission::permission_p -party_id $user_id -object_id [dotlrn::get_package_id] -privilege admin]} { - set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] - set color [my user_color $user_id] - - set msg $msg - my log "-- msg=$msg" - - if {$get_new && [info command ::thread::mutex] ne ""} { - # we could use the streaming interface - my broadcast_msg [Message new -volatile -time [clock seconds] \ + if {$get_new && [info command ::thread::mutex] ne ""} { + # we could use the streaming interface + my broadcast_msg [Message new -volatile -time [clock seconds] \ -user_id $user_id -msg $msg -color $color] - - } + } - set msg_id $now.$user_id - if { ![nsv_exists $array-login $user_id] } { - nsv_set $array-login $user_id [clock seconds] - } - - nsv_set $array $msg_id [list $now [clock seconds] $user_id $msg $color] - nsv_set $array-seen newest $now - nsv_set $array-seen last [clock seconds] - nsv_set $array-last-activity $user_id $now + set msg_id $now.$user_id + if { ![nsv_exists $array-login $user_id] } { + nsv_set $array-login $user_id [clock seconds] + } + nsv_set $array $msg_id [list $now [clock seconds] $user_id $msg $color] + nsv_set $array-seen newest $now + nsv_set $array-seen last [clock seconds] + nsv_set $array-last-activity $user_id $now # this in any case a valid result, but only needed for the polling interface - if {$get_new} {my get_new} - } - - - } else { - - set user_id [expr {[info exists uid] ? $uid : [my set user_id]}] - set color [my user_color $user_id] - - set msg $msg - my log "-- msg=$msg" - - if {$get_new && [info command ::thread::mutex] ne ""} { - # we could use the streaming interface - my broadcast_msg [Message new -volatile -time [clock seconds] \ - -user_id $user_id -msg $msg -color $color] - - } + if {$get_new} {my get_new} + } - set msg_id $now.$user_id - if { ![nsv_exists $array-login $user_id] } { - nsv_set $array-login $user_id [clock seconds] - } - nsv_set $array $msg_id [list $now [clock seconds] $user_id $msg $color] - nsv_set $array-seen newest $now - nsv_set $array-seen last [clock seconds] - nsv_set $array-last-activity $user_id $now - # 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 { [my exists user_id] && [my set user_id] != -1 } } @@ -136,9 +84,8 @@ return 1 } - Chat instproc get_new {} { - my instvar array now session_id chat_id - + Chat instproc get_new {} { + my instvar array now session_id 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" @@ -154,53 +101,45 @@ #my log "--c setting session_id $session_id: $now" } else { #my log "--c nothing new for $session_id" - } - my render2 -chat_id $chat_id + } + my render } - Chat instproc get_all {} { - my instvar array now session_id chat_id - + Chat instproc get_all {} { + my instvar array now session_id foreach {key value} [nsv_array get $array] { - foreach {timestamp secs user msg color} $value break if {[my check_age $key [expr {($now - $timestamp) / 1000}]]} { my add [Message new -time $secs -user_id $user -msg $msg -color $color] } - } - #my log "--c setting session_id $session_id: $now" + } + #my log "--c setting session_id $session_id: $now" nsv_set $array-seen $session_id $now - my render2 -chat_id $chat_id + my render } - Chat instproc sweeper2 {} { - my instvar array now chat_id - my log "-- starting" - - foreach {user timestamp} [nsv_array get $array-last-activity] { - set ago [expr {($now - $timestamp) / 1000}] - # was 1200 - if {$ago > 1000} { - my add_msg -get_new false -uid $user "auto logout" - db_dml insert_users {delete from chat_room_user_id where room_id = :chat_id and user_id = :user;} - nsv_unset $array-last-activity $user - nsv_unset $array-color $user - nsv_unset $array-login $user - + Chat instproc sweeper {} { + my instvar array now + my log "-- starting" + foreach {user timestamp} [nsv_array get $array-last-activity] { + ns_log Notice "YY at user $user with $timestamp" + set ago [expr {($now - $timestamp) / 1000}] + ns_log Notice "YY 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 } - } - my log "-- ending" } - Chat instproc logout {} { - my instvar array user_id chat_id - + Chat instproc logout {} { + my instvar array user_id + ns_log Notice "YY User $user_id logging out of chat" my add_msg -get_new false [_ chat.has_left_the_room]. - - db_dml insert_users {delete from chat_room_user_id where room_id = :chat_id and user_id = :user_id;} - 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 @@ -211,233 +150,39 @@ } Chat instproc init_user_color {} { - my instvar array user_id if { [nsv_exists $array-color $user_id] } { return } else { - set colors [parameter::get -parameter UserColors -default [[my info class] set colors]] + set colors [parameter::get -parameter UserColors -default [[my info class] set colors]] + # ns_log notice "getting colors of [my info class] = [info exists colors]" set color [lindex $colors [expr { [nsv_get $array-color idx] % [llength $colors] }]] nsv_set $array-color $user_id $color nsv_incr $array-color idx } } - Chat instproc init_user_color {} { - - my instvar array user_id - if { [nsv_exists $array-color $user_id] } { - return - } else { - set colors [parameter::get -parameter UserColors -default [[my info class] set colors]] - set color [lindex $colors [expr { [nsv_get $array-color idx] % [llength $colors] }]] - nsv_set $array-color $user_id $color - nsv_incr $array-color idx - } - } - - - Chat instproc get_users {} { - my instvar chat_id set output "" - set count 0 - - - foreach {user_id timestamp} [my active_user_list] { - - set count [expr $count+1] + foreach {user_id timestamp} [my active_user_list] { if {$user_id > 0} { - db_1row room_info { - select count(1) as info - from chat_registered_users - where room_id = :chat_id - and user_id = :user_id - } - if { $info > 0 } { - db_1row room_info { - select alias as alias - from chat_registered_users - where room_id = :chat_id - and user_id = :user_id - } - - set pp [my sweeper2] - - set color [my user_color $user_id] - set diff [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1] - set package_id [ad_conn package_id] - db_1row url { - select site_node__url(node_id) as url - from site_nodes - where object_id=:package_id - } - - set userlink [my user_link2 -user_id $user_id -alias $alias] - set user_id2 [ad_conn user_id] - set url2 "private-room?room_id=$chat_id&user_id1=$user_id&user_id2=$user_id2" - append link $url $url2 - set address [my encode $link] - set narrow [dt_right_arrow] - - append output "$userlink $diff" - - } - if { $info eq 0 } { - set link "" - set package_id [ad_conn package_id] - db_1row url { - select site_node__url(node_id) as url - from site_nodes - where object_id=:package_id - } - set diff [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1] - set userlink [my user_link -user_id $user_id] - set user_id2 [ad_conn user_id] - set url2 "private-room?room_id=$chat_id&user_id1=$user_id&user_id2=$user_id2" - append link $url $url2 - set address [my encode $link] - set narrow [dt_right_arrow] - - append output "$userlink $diff" - } + set diff [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1] + set userlink [my user_link -user_id $user_id] + append output "$userlink$diff\n" } } return $output } - - Chat instproc get_files {} { - my instvar chat_id - set output "" - set count 0 - - db_foreach file "select distinct fil.file as file, - fil.send_file_id, - ao.package_id, - cri.parent_id, - cri.item_id - from chat_rooms_files_sent as fil, - acs_objects ao, - cr_items cri, - cr_revisions crr - where fil.send_file_id = crr.revision_id - and crr.item_id = cri.item_id - and cri.item_id = ao.object_id - and fil.room_id = :chat_id " { - - if {[apm_package_enabled_p dotlrn]} { - set community_id [dotlrn_community::get_community_id] - } else { - set community_id "" - } - if { ![string eq $community_id ""] } { - set fs_package_id [site_node_apm_integration::get_child_package_id \ - -package_id [dotlrn_community::get_package_id $community_id] \ - -package_key "file-storage"] - } else { - set fs_package_id $package_id - } - - - - set root_folder_id [fs::get_root_folder -package_id $fs_package_id] - - - set root_folder_id [fs::get_root_folder -package_id $fs_package_id] -# set folder_path [db_exec_plsql get_folder_path { select content_item__get_path(111,:root_folder_id); }] - set fs_file_url [db_string get_fs_file_url { - select - fs.file_upload_name - from fs_objects fs - where fs.live_revision = :send_file_id - }] - set file_url "[apm_package_url_from_id $fs_package_id]download/${file}?[export_vars -url {{file_id $item_id}}]" - append output "$file" -# set url [ad_conn url] -# set inicio 0 -# set final [expr [string length $url]-16] -# set comm_name [string range $url $inicio $final] -# if { [string length $comm_name] > 0 } { -# append output "$file" -# } else { -# set user_id [ad_conn user_id] -# acs_user::get -user_id $user_id -array user -# set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] -# set folder_id "$name's Shared Files" -# db_1row room_info { -# select fs.folder_id as id -# from fs_folders as fs -# where fs.name = :folder_id -# } -# set folder_id $id -# append url_file "dotlrn_fs_" $user_id -# append url_file "_root_folder" -# append url_file2 "dotlrn_fs_" $user_id -# append url_file2 "_shared_folder" -# #append output "$file" -# append output "$file" -# } - } if_no_rows { - append output "[_ chat.no_files]" - } - return $output - } - - Chat instproc login {} { - my instvar array user_id now chat_id + Chat instproc login {} { + my instvar array user_id now # was the user already active? - - db_1row room_info { - select maximal_participants as maximal - from chat_rooms as cp - where cp.room_id = :chat_id - } - db_1row room_info { - select count(cr.room_id) as count - from chat_room_user_id as cr - where cr.room_id = :chat_id - } - if { $count < $maximal} { - db_1row room_info { - select count(cr.room_id) as count2 - from chat_room_user_id as cr - where cr.user_id = :user_id - and cr.room_id = :chat_id - } - if { $count2 == 0 } { - db_dml insert_users {insert into chat_room_user_id (room_id,user_id) values (:chat_id,:user_id);} - } - } - if { $count == $maximal} { - #Check if the user is active and the room is full - db_1row room_info { - select count(chat_room_user_id.user_id) as count - from chat_room_user_id - where chat_room_user_id.user_id = :user_id - and chat_room_user_id.room_id = :chat_id - } - if { $count == 0 } { - if { [permission::permission_p -party_id $user_id -object_id [dotlrn::get_package_id] -privilege admin] } { - #db_dml insert_users {insert into chat_room_user_id (room_id,user_id) values (:chat_id,:user_id);} - } else { - ns_return 200 text/html "\ -
[_ chat.You_dont_have_permission_room]
\ - " - ad_script_abort - } - } - } - - if {![nsv_exists $array-last-activity $user_id]} { + if {![nsv_exists $array-last-activity $user_id]} { my add_msg -get_new false [_ xotcl-core.has_entered_the_room] - - - - } - my encoder noencode - #my log "--c setting session_id [my set session_id]: $now" - my get_all + } + my encoder noencode + #my log "--c setting session_id [my set session_id]: $now" + my get_all } Chat instproc user_color { user_id } { @@ -454,70 +199,22 @@ return [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] } - Chat instproc user_link { -user_id -color } { - my instvar chat_id - if {$user_id > 0} { - set name [my user_name $user_id] + Chat instproc user_link { -user_id -color } { + if {$user_id > 0} { + set name [my user_name $user_id] set url "/shared/community-member?user%5fid=$user_id" if {![info exists color]} { set color [my user_color $user_id] } - set user_id2 [ad_conn user_id] - set user_info "#chat.user_info#" - set creator "$name" + set creator "$name" } elseif { $user_id == 0 } { set creator "Nobody" } else { set creator "System" } return [my encode $creator] } - - Chat instproc user_link2 { -user_id -color -alias} { - my instvar chat_id - if {$user_id > 0} { - set name $alias - set url "/shared/community-member?user%5fid=$user_id" - set user_id2 [ad_conn user_id] - - if {![info exists color]} { - set color [my user_color $user_id] - } - set user_info "#chat.user_info#" - set creator "$alias" - - } elseif { $user_id == 0 } { - set creator "Nobody" - } else { - set creator "System" - } - set tt [my encode $creator] - - return [my encode $creator] - } - - Chat instproc user_link3 { -url -color} { - - set creator "$url" - - return [my encode $creator] - } - - Chat instproc user_link4 { -url -color} { - - set creator "$url" - - return [my encode $creator] - } - - Chat instproc user_link5 { -url -msg -color} { - - set creator "$msg" - - 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} @@ -526,7 +223,7 @@ string map [list \n \\n {"} {\"} ' {\'}] $string ;#" } - Chat instproc json_encode_msg {msg} { + Chat instproc json_encode_msg {msg} { set old [my encoder] my encoder noencode ;# just for user_link set userlink [my user_link -user_id [$msg user_id] -color [$msg color]] @@ -560,198 +257,36 @@ -user_id $user_id -color $color \ -msg [_ xotcl-core.has_entered_the_room] ]] [my mode] } - - + Chat instproc render {} { my orderby time set result "" - - foreach child [my children] { - + 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" \ "$userlink:" \ "[my encode $msg]

\n" - } - return $result - } - - #pablomp - - Chat instproc render2 {-chat_id } { - my instvar array - my orderby time - set result "" - set msg_true "f" - - - db_1row room_info { - select room.maximal_participants as maxp - from chat_rooms as room - where room.room_id = :chat_id - } - - #[nsv_get $array $msg] - foreach aux [my array] { - - set msg [$array msg] - set msg_all "" - - for {set i 0} {$i < [llength $msg]} {incr i 1} { - set word [lindex $msg $i] - - - for {set j 0} {$j < [llength $word]} {incr j 1} { - if { [string range $word $j $j] eq "h" } { - set aux [expr $j+1] - if { [string range $word $aux [expr $aux+5] ] eq "ttp://" } { - set url [lindex $msg $i] - lappend msg_all $i - set msg_true "t" - - } - } else { - if { [string range $word $j $j] eq "w" } { - set aux [expr $j+1] - if { [string range $word $aux [expr $aux+1] ] eq "ww" } { - set url [lindex $msg $i] - lappend msg_all $i - set msg_true "t" - - } - } - } - } - } - - 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 timeshort2 [clock format [$child time] -format {[%D]}] - - db_1row room_info { - select count(1) as info - from chat_registered_users - where room_id = :chat_id - and user_id = :user_id - } - - - - if { $info > 0 } { - db_1row room_info { - select alias as alias - from chat_registered_users - where room_id = :chat_id - and user_id = :user_id - } - set userlink [my user_link2 -user_id $user_id -color $color -alias $alias] - - if {$msg_true eq "t"} { - - append result "

$timeshort" \ - "$userlink:" - - append result "" - set k 0 - for {set l 0} {$l < [llength $msg]} {incr l 1} { - - - if { $l eq [lindex $msg_all $k] } { - - if { [string range [lindex $msg $l] 0 0] eq "w" } { - set msg_url [my user_link4 -url [lindex $msg $l] -color $color] - } else { - set msg_url [my user_link3 -url [lindex $msg $l] -color $color] - } - - append result $msg_url - append result " " - if { $k < [llength $msg_all]} { - set k [expr $k+1] - } - } else { - append result [lindex $msg $l] - append result " " - } - - - } - append result "

\n" - } else { - append result "

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

\n" - } - } - - if {$info eq 0} { - set userlink [my user_link -user_id $user_id -color $color] - - if {$msg_true eq "t"} { - - append result "

$timeshort" \ - "$userlink:" - - append result "" - set k 0 - for {set l 0} {$l < [llength $msg]} {incr l 1} { - - - if { $l eq [lindex $msg_all $k] } { - - if { [string range [lindex $msg $l] 0 0] eq "w" } { - set msg_url [my user_link4 -url [lindex $msg $l] -color $color] - } else { - set msg_url [my user_link3 -url [lindex $msg $l] -color $color] - } - append result $msg_url - append result " " - if { $k < [llength $msg_all]} { - set k [expr $k+1] - } - } else { - append result [lindex $msg $l] - append result " " - } - - - } - append result "

\n" - } else { - - append result "

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

\n" - } - } - } - 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----------swee_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 -sweeper2 + my log "--Chat_id $chat_id" + my new -volatile -chat_id $chat_id -user_id 0 -session_id 0 -init -sweeper } } my log "-- ending"