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
}
}
-