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.11 -r1.12 --- openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 2 Dec 2006 19:07:01 -0000 1.11 +++ openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 7 Jun 2007 09:19:51 -0000 1.12 @@ -1,21 +1,24 @@ ad_library { generic chat - chat procs - - @creation-date 2006-02-02 - @author Gustaf Neumann - @cvs-id $Id$ + + @author Gustaf Neumann and Pablo Mu�oz(pablomp@tid.es) + } 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]} @@ -31,32 +34,81 @@ 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 - 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" + + my instvar array now user_id chat_id - 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 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] \ -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} - } + 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] + + } + 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 } } @@ -84,8 +136,9 @@ return 1 } - Chat instproc get_new {} { - my instvar array now session_id + Chat instproc get_new {} { + my instvar array now session_id chat_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" @@ -101,45 +154,53 @@ #my log "--c setting session_id $session_id: $now" } else { #my log "--c nothing new for $session_id" - } - my render + } + my render2 -chat_id $chat_id } - Chat instproc get_all {} { - my instvar array now session_id + Chat instproc get_all {} { + my instvar array now session_id chat_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 render + my render2 -chat_id $chat_id } - 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 + 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 + } + } + my log "-- ending" } - Chat instproc logout {} { - my instvar array user_id - ns_log Notice "YY User $user_id logging out of chat" + Chat instproc logout {} { + my instvar array user_id chat_id + 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 @@ -150,39 +211,233 @@ } 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]] - # ns_log notice "getting colors of [my info class] = [info exists colors]" + 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 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 "" - foreach {user_id timestamp} [my active_user_list] { + set count 0 + + + foreach {user_id timestamp} [my active_user_list] { + + set count [expr $count+1] if {$user_id > 0} { - 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" + 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" + } } } return $output } - Chat instproc login {} { - my instvar array user_id now + + 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 # was the user already active? - if {![nsv_exists $array-last-activity $user_id]} { + + 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]} { 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 } { @@ -199,22 +454,70 @@ 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] + Chat instproc user_link { -user_id -color } { + my instvar chat_id + 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 creator "$name" + set user_id2 [ad_conn user_id] + set user_info "#chat.user_info#" + 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} @@ -223,7 +526,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]] @@ -257,36 +560,198 @@ -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" + my log "-- starting----------swee_all_chats" 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 "--Chat_id $chat_id" + my new -volatile -chat_id $chat_id -user_id 0 -session_id 0 -init -sweeper2 } } my log "-- ending"