Index: openacs-4/packages/chat/tcl/chat-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/chat/tcl/chat-procs.tcl,v diff -u -r1.11.6.2 -r1.11.6.3 --- openacs-4/packages/chat/tcl/chat-procs.tcl 28 Oct 2016 18:57:36 -0000 1.11.6.2 +++ openacs-4/packages/chat/tcl/chat-procs.tcl 22 Nov 2016 18:34:35 -0000 1.11.6.3 @@ -7,7 +7,10 @@ @cvs-id $Id$ } -ad_proc -private chat_start_server {} { Start Java chat server. } { +ad_proc -private chat_start_server { +} { + Start Java chat server. +} { if {[nsv_get chat server_started]} { return @@ -43,7 +46,12 @@ nsv_set chat server_started 1 } -ad_proc -private chat_broadcast_to_applets {host port} { Broadcast chat message from HTML client to Java server. } { +ad_proc -private chat_broadcast_to_applets { + host + port +} { + Broadcast chat message from HTML client to Java server. +} { # Chat server must already started otherwise error will occur. set fds [ns_sockopen -nonblock $host $port] @@ -70,9 +78,13 @@ } } +ad_proc -private chat_receive_from_server { + host + port +} { + Receive messages from Java clients. +} { -ad_proc -private chat_receive_from_server {host port} { Receive messages from Java clients. } { - set fds [ns_sockopen -nonblock $host $port] set r [lindex $fds 0] @@ -81,7 +93,13 @@ ns_log Notice "chat_receive_from_server: Listening for messages from applets." - puts $w "-1AOL_READERT-1" + puts $w " + + -1 + AOL_READER + T + -1 + " flush $w set running 1 @@ -93,45 +111,34 @@ foreach r $rfds { if {[ns_sockcheck $r] && [set line [string trim [gets $r]]] != ""} { - + regexp "(.*)" $line match room_id regexp "(.*)" $line match screen_name regexp "(.*)" $line match msg regexp "(.*)" $line match user_id if {![nsv_exists chat_room $room_id]} { - nsv_set chat_room $room_id {} + nsv_set chat_room $room_id {} } - ns_log Notice "YY Nachricht: $msg" ::chat::Chat c1 -volatile -chat_id $room_id -user_id $user_id -session_id 0 switch $msg { "/enter" { c1 login - # apisano: I think we don't need explicit - # message about entering the room, as this is - # already issued by the login method of parent - # chat class in xotcl-core. - # set msg [_ xotcl-core.has_entered_the_room] } "/leave" { c1 logout - # apisano: I think we don't need explicit - # message about leaving the room, as this is - # already issued by the logout method of parent - # chat class in xotcl-core. - # set msg [_ xotcl-core.has_left_the_room] } default { c1 add_msg -uid $user_id $msg } } - chat_room_get -room_id $room_id -array room_info - if { $room_info(archive_p) == "t" } { - if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $msg} errmsg]} { - ns_log error "chat_post_message_to_db: error: $errmsg" - } - } + chat_room_get -room_id $room_id -array room_info + if { $room_info(archive_p) == "t" } { + if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $msg} errmsg]} { + ns_log error "chat_post_message_to_db: error: $errmsg" + } + } nsv_lappend chat_room $room_id $line @@ -150,11 +157,36 @@ } { Log chat message to the database. } { - # ns_log Notice $msg - db_exec_plsql post_message {} + db_string post_message {} +} +# create a cache for the chat package +if {"chat_room_get_not_cached" ni [ns_cache_names]} { + ns_cache_create chat_room_get_not_cached 1000 } +ad_proc -public chat_room_get { + {-room_id {}} + {-array:required} +} { + Get all the information about a chat room into an array +} { + upvar $array row + array set row [ns_cache_eval -- chat_room_get_not_cached $room_id { + chat_room_get_not_cached $room_id + }] +} + +ad_proc -private chat_room_get_not_cached { + room_id +} { + db_1row select_user_info { + select * from chat_rooms + where room_id = :room_id + } -column_array row + return [array get row] +} + ad_proc -public chat_room_new { {-description ""} {-moderated_p f} @@ -168,19 +200,41 @@ {-creation_user ""} {-creation_ip ""} pretty_name - } { Create new chat room. Return room_id if successful else raise error. -} { +} { db_transaction { set room_id [db_string create_room {}] + if {$creation_user ne ""} { + foreach privilege {edit view delete} { + permission::grant \ + -party_id $creation_user \ + -object_id $room_id \ + -privilege chat_room_${privilege} + } + permission::grant \ + -party_id $creation_user \ + -object_id $room_id \ + -privilege chat_transcript_create + } } - db_exec_plsql grant_permission {} - return $room_id } +ad_proc -public chat_room_exists_p { + room_id +} { + Return wether a chat room exists + + @return a boolean +} { + return [db_0or1row query { + select 1 from chat_rooms + where room_id = :room_id + }] +} + ad_proc -public chat_room_edit { room_id pretty_name @@ -195,53 +249,51 @@ } { Edit information on chat room. All information require. } { - db_exec_plsql edit_room {} + db_string edit_room {} + ns_cache_flush -- chat_room_get_not_cached $room_id } ad_proc -public chat_room_delete { room_id } { Delete chat room. } { - db_exec_plsql delete_room {} + db_string delete_room {} + ns_cache_flush -- chat_room_get_not_cached $room_id } ad_proc -public chat_room_message_delete { room_id } { Delete all message in the room. } { - db_exec_plsql delete_message {} + db_string delete_message {} } ad_proc -public chat_message_count { room_id } { Get message count in the room. } { - - return [db_exec_plsql message_count {}] + return [db_string message_count {} -default 0] } - - ad_proc -public room_active_status { room_id } { Get room active status. } { - - return [db_string get_active { select active_p from chat_rooms where room_id = :room_id}] - + chat_room_get -room_id $room_id -array c + return $c(active_p) } ad_proc -public chat_room_name { room_id } { Get chat room name. } { - return [db_string get_room_name {} -default "" ] - + chat_room_get -room_id $room_id -array c + return $c(pretty_name) } ad_proc -public chat_moderator_grant { @@ -250,7 +302,10 @@ } { Grant party a chat moderate privilege to this chat room. } { - db_exec_plsql grant_moderator {} + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_room_moderate" } ad_proc -public chat_moderator_revoke { @@ -259,9 +314,10 @@ } { Revoke party a chat moderate privilege to this chat room. } { - - db_exec_plsql revoke_moderator {} - + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_room_moderate" } ad_proc -public chat_user_grant { @@ -271,19 +327,28 @@ Grant party a chat privilege to this chat room. } { db_transaction { - db_exec_plsql grant_user {} + foreach privilege {read write} { + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege chat_${privilege} + } } } - ad_proc -public chat_user_revoke { room_id party_id } { Revoke party a chat privilege to this chat room. } { db_transaction { - db_exec_plsql revoke_user {} + foreach privilege {read write} { + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege chat_${privilege} + } } } @@ -293,21 +358,22 @@ } { Explicit ban user from this chat room. } { - util_memoize_flush \ - "permission::permission_p_not_cached -party_id $party_id -object_id $room_id -privilege chat_ban" - db_exec_plsql ban_user {} + permission::grant \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_ban" } - ad_proc -public chat_user_unban { room_id party_id } { unban user from this chat room. } { - util_memoize_flush \ - "permission::permission_p_not_cached -party_id $party_id -object_id $room_id -privilege chat_ban" - db_exec_plsql ban_user {} + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_ban" } ad_proc -public chat_revoke_moderators { @@ -317,28 +383,20 @@ Revoke a list of parties of a moderate privilege from this room. } { foreach party_id $revoke_list { - db_dml revoke_moderate { - begin - acs_persmission.revoke_permission(:room_id, :party_id, 'chat_moderate_room'); - end - } + permission::revoke \ + -party_id $party_id \ + -object_id $room_id \ + -privilege "chat_moderate_room" } - } ad_proc -public chat_room_moderate_p { room_id } { Return the moderate status of this chat room. } { - set moderate_p [db_string get_chat_room_moderate { - select moderated_p - from chat_rooms - where room_id = :room_id - }] - - return $moderate_p - + chat_room_get -room_id $room_id -array c + return $c(moderated_p) } ad_proc -public chat_user_name { @@ -359,7 +417,7 @@ } { Post message to the chat room and broadcast to all applet clients. Used by ajax + html. } { - if {$moderator_p == 1 } { + if {$moderator_p == 1} { set status "approved" } else { set status "pending" @@ -369,23 +427,22 @@ if {$default_client eq "java"} { set chat_msg "[chat_user_name $user_id]$user_id$room_id$message$status" - # Add message to queue. Notify thread responsible for + # Add message to queue. Notify thread responsible for # broadcast message to applets. nsv_set chat html_message $chat_msg - ns_mutex unlock [nsv_get chat new_message] + ns_mutex unlock [nsv_get chat new_message] } - + # do not write messages to the database if the room should not be archived chat_room_get -room_id $room_id -array room_info if { $room_info(archive_p) == "f" } { return } - + # write message to the database if {[catch {chat_post_message_to_db -creation_user $user_id $room_id $message} errmsg]} { ns_log error "chat_post_message_to_db: error: $errmsg" } } - ad_proc -public chat_moderate_message_post { room_id user_id @@ -405,31 +462,21 @@ room_id user_id } { - Retrieve all messages from the chat room starting from first_msg_id. Return messages are store in multirow format. + Retrieve all messages from the chat room starting from + first_msg_id. Return messages are store in multirow format. } { - ns_log debug "chat_message_retrieve: starting message retrieve" # The first time html client enter chat room, chat_room variable # is not initialize correctly. Therefore I just hard code the - # variable. - # apisano: I don't think hardcoded message should be here anymore, - # as message about user entering the room is already issued by the - # parent chat class in xotcl-core when we issue the login method + # variable. if {![nsv_exists chat_room $room_id]} { nsv_set chat_room $room_id {} - # nsv_set chat_room $room_id [list " - # - # [chat_user_name $user_id] - # $room_id - # [_ chat.has_entered_the_room] - # approved - # "] } set user_name [chat_user_name $user_id] - upvar "$msgs:rowcount" counter + upvar "$msgs:rowcount" counter set chat_messages [nsv_get chat_room $room_id] @@ -438,16 +485,15 @@ set cnt $count set counter 0 - #foreach msg $chat_messages - for { set i [expr {$cnt - 1}] } { $i >= 0 } { set i [expr {$i - 1}] } { + #foreach msg $chat_messages + for { set i [expr {$cnt - 1}] } { $i >= 0 } { incr i -1 } { set msg [lindex $chat_messages $i] regexp "(.*)" $msg match screen_name regexp "(.*)" $msg match chat_msg regexp "(.*)" $msg match status - - if {$status eq "pending" || $status eq "rejected"} { - continue; + if {$status in {"pending" "rejected"}} { + continue } upvar "$msgs:[expr {$counter + 1}]" array_val @@ -461,10 +507,8 @@ return } } - } - ad_proc -public chat_transcript_new { {-description ""} {-context_id ""} @@ -476,25 +520,28 @@ } { Create chat transcript. } { - db_transaction { - set transcript_id [db_exec_plsql create_transcript {}] - if { $transcript_id ne 0 } { + set transcript_id [db_string create_transcript {}] + if { $transcript_id != 0 } { db_dml update_contents {} - db_exec_plsql grant_permission {} + foreach privilege {edit view delete} { + permission::grant \ + -party_id $creation_user \ + -object_id $transcript_id \ + -privilege chat_transcript_${privilege} + } } } return $transcript_id - } ad_proc -public chat_transcript_delete { transcript_id } { Delete chat transcript. } { - db_exec_plsql delete_transcript {} + db_string delete_transcript {} } ad_proc -public chat_transcript_edit { @@ -505,54 +552,45 @@ } { Edit chat transcript. } { - db_exec_plsql edit_transcript {} - db_dml update_contents {} + db_transaction { + db_string edit_transcript {} + db_dml update_contents {} + } } -ad_proc -public chat_room_get { - {-room_id {}} - {-array:required} +ad_proc -private chat_flush_rooms {} { + Flush the messages in all of the chat rooms } { - Get all the information about a chat room into an array -} { - upvar $array row - array set row [util_memoize [list chat_room_get_not_cached $room_id]] -} - -ad_proc -private chat_room_get_not_cached { - room_id -} { - db_1row select_user_info {select * from chat_rooms where room_id = :room_id} -column_array row - return [array get row] -} - -ad_proc -private chat_flush_rooms {} {Flush the messages in all of the chat rooms} { - # ns_log Notice "YY Starting chat_flush_rooms operation" - set room_ids [db_list get_rooms *SQL*] + set room_ids [db_list get_rooms *SQL*] foreach room_id $room_ids { chat_room_flush $room_id } -} +} -ad_proc -private chat_room_flush { room_id } {Flush the messages a single chat room} { - # ns_log Notice "YY flushing room $room_id" +ad_proc -private chat_room_flush { + room_id +} { + Flush the messages a single chat room +} { db_transaction { - array set room_info [chat_room_get_not_cached $room_id] - set contents "" + chat_room_get $room_id -array room_info # do we have to create a transcript for the room if { $room_info(auto_transcript_p) == "t" } { # build a list of all messages - db_foreach get_archives_messages {} { - append contents "\[$creation_date\] [chat_user_name $creation_user]: $msg
\n" + set contents [list] + foreach message [db_list_of_lists get_archives_messages {}] { + lassign $message msg creation_user creation_date + lappend contents "\[$creation_date\] [chat_user_name $creation_user]: $msg" } if { $contents ne "" } { + set today [clock format [clock seconds] -format "%d.%m.%Y"] chat_transcript_new \ -description "#chat.automatically_created_transcript#" \ - "#chat.transcript_of_date# [clock format [clock seconds] -format "%d.%m.%Y"]" $contents $room_id + "#chat.transcript_of_date# $today" \ + [join $contents "
\n"] $room_id } } # clear all the messages in the room chat_room_message_delete $room_id } } -