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 -N -r1.5 -r1.6 --- openacs-4/packages/chat/tcl/chat-procs.tcl 14 Mar 2006 12:16:09 -0000 1.5 +++ openacs-4/packages/chat/tcl/chat-procs.tcl 24 Jun 2006 14:23:41 -0000 1.6 @@ -9,7 +9,7 @@ ad_proc -private chat_start_server {} { Start Java chat server. } { - if [nsv_get chat server_started] { + if {[nsv_get chat server_started]} { return } ns_log notice "chat_start_server: Starting chat server" @@ -62,7 +62,7 @@ while { 1 } { # Wait until there is new message in queue. ns_mutex lock [nsv_get chat new_message] - if [nsv_exists chat html_message] { + if {[nsv_exists chat html_message]} { # Get message from queue. puts $w [nsv_get chat html_message] flush $w @@ -98,15 +98,33 @@ regexp "(.*)" $line match screen_name regexp "(.*)" $line match msg regexp "(.*)" $line match user_id - if ![nsv_exists chat_room $room_id] { + if {![nsv_exists chat_room $room_id]} { nsv_set chat_room $room_id {} } - - 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" + 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 + set msg [_ xotcl-core.has_entered_the_room] + } + "/leave" { + c1 logout + 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) eq "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 } else { @@ -124,7 +142,7 @@ } { Log chat message to the database. } { - ns_log Notice $msg + # ns_log Notice $msg db_exec_plsql post_message {} } @@ -133,6 +151,8 @@ {-moderated_p f} {-active_p t} {-archive_p f} + {-auto_flush_p t} + {-auto_transcript_p f} {-context_id ""} {-creation_user ""} {-creation_ip ""} @@ -158,6 +178,8 @@ moderated_p active_p archive_p + auto_flush_p + auto_transcript_p } { Edit information on chat room. All information require. } { @@ -259,6 +281,8 @@ } { 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 {} } @@ -269,6 +293,8 @@ } { 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 {} } @@ -308,9 +334,10 @@ } { Return display name of this user to use in chat. } { + acs_user::get -user_id $user_id -array user + set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}] + return $name - return [db_exec_plsql get_chat_user_name {}] - } ad_proc -public chat_message_post { @@ -319,20 +346,32 @@ message moderator_p } { - Post message to the chat room and broadcast to all applet clients. Only use by HTML client. + Post message to the chat room and broadcast to all applet clients. Used by ajax + html. } { if {$moderator_p == "1" } { set status "approved" } else { set status "pending" } - set chat_msg "[chat_user_name $user_id]$user_id$room_id$message$status" - # Add message to queue. Notify thread responsible for broadcast message to applets. + set default_client [parameter::get -parameter "DefaultClient" -default "ajax"] - nsv_set chat html_message $chat_msg - ns_mutex unlock [nsv_get chat new_message] - + 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 + # broadcast message to applets. + nsv_set chat html_message $chat_msg + 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) eq "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" + } } @@ -362,13 +401,13 @@ # The first time html client enter chat room, chat_room variable is not initialize correctly. # Therefore I just hard code the variable. - if ![nsv_exists chat_room $room_id] { + if {![nsv_exists 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] @@ -378,14 +417,14 @@ set counter 0 #foreach msg $chat_messages - for { set i [expr $cnt - 1] } { $i >= 0 } { set i [expr $i - 1] } { + for { set i [expr {$cnt - 1}] } { $i >= 0 } { set i [expr {$i - 1}] } { set msg [lindex $chat_messages $i] regexp "(.*)" $msg match screen_name regexp "(.*)" $msg match chat_msg regexp "(.*)" $msg match status - if {$status == "pending" || $status == "rejected"} { + if {$status eq "pending" || $status eq "rejected"} { continue; } @@ -396,7 +435,7 @@ incr counter set array_val(rownum) $counter - if {$screen_name == $user_name && $chat_msg == "has entered the room."} { + if {$screen_name == $user_name && $chat_msg eq "has entered the room."} { return } } @@ -418,16 +457,10 @@ db_transaction { set transcript_id [db_exec_plsql create_transcript {}] - db_exec_plsql grant_permission {} -# -# db_dml transcript_content { -# update chat_transcripts -# set contents = empty_clob() -# where transcript_id = :transcript_id -# returning contents into :1 -# } -clobs [list $contents] -# } on_error { -# ad_return_complaint 1 "Insert fail: $errmsg" + if { $transcript_id ne 0 } { + db_dml update_contents {} + db_exec_plsql grant_permission {} + } } return $transcript_id @@ -450,26 +483,54 @@ } { Edit chat transcript. } { - db_transaction { - db_exec_plsql edit_transcript { + db_exec_plsql edit_transcript {} + db_dml update_contents {} +} - } - #db_dml transcript_content { - # update chat_transcripts - # set contents = empty_clob() - # where transcript_id = :transcript_id - # returning contents into :1 - #} -clobs [list $contents] - } - +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 [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*] + 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" + db_transaction { + array set room_info [chat_room_get_not_cached $room_id] + set contents "" + # do we have to create a transcript for the room + if { $room_info(auto_transcript_p) eq "t" } { + # build a list of all messages + db_foreach get_archives_messages {} { + append contents "\[$creation_date\] [chat_user_name $creation_user]: $msg
\n" + } + if { $contents ne "" } { + chat_transcript_new \ + -description "#chat.automatically_created_transcript#" \ + "#chat.transcript_of_date# [clock format [clock seconds] -format "%d.%m.%Y"]" $contents $room_id + } + } + # clear all the messages in the room + chat_room_message_delete $room_id + } +} - - - - - -