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.13 -r1.14
--- openacs-4/packages/chat/tcl/chat-procs.tcl 17 Jun 2016 17:36:11 -0000 1.13
+++ openacs-4/packages/chat/tcl/chat-procs.tcl 7 Aug 2017 23:48:07 -0000 1.14
@@ -7,8 +7,15 @@
@cvs-id $Id$
}
-ad_proc -private chat_start_server {} { Start Java chat server. } {
+# TODO: all the remaining Java stuff should fade away at some point,
+# its status is unknown and we won't be allowed to have binaries into
+# the core by distros.
+ad_proc -private chat_start_server {
+} {
+ Start Java chat server.
+} {
+
if {[nsv_get chat server_started]} {
return
}
@@ -23,7 +30,7 @@
# Wait until chat server started before spawning new threads connecting to the server.
while { $done == 0} {
- if [catch {set fds [ns_sockopen -nonblock $host_location $port]} errmsg] {
+ if {[catch {set fds [ns_sockopen -nonblock $host_location $port]} errmsg]} {
set done 0
} else {
set done 1
@@ -43,7 +50,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 +82,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 +97,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,37 +115,37 @@
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
- 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
+ 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]} {
+ ad_log error "chat_post_message_to_db: error: $errmsg"
+ }
+ }
nsv_lappend chat_room $room_id $line
@@ -142,35 +164,125 @@
} {
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_cache" ni [ns_cache_names]} {
+ # these should be around 1000 entries
+ ns_cache_create chat_room_cache 350000
}
+
+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_cache $room_id {
+ chat_room_get_not_cached $room_id
+ }]
+}
+
+ad_proc -private chat_room_get_not_cached {
+ room_id
+} {
+ if {![db_0or1row select_room_info {
+ select * from chat_rooms
+ where room_id = :room_id
+ } -column_array row]} {
+ set msg "Cannot find data for chatroom $room_id"
+ ad_log error $msg
+ error $msg
+ }
+ acs_object::get \
+ -object_id $room_id \
+ -array obj
+ set row(creation_user) $obj(creation_user)
+ set row(creation_date) $obj(creation_date_ansi)
+ set row(creation_ip) $obj(creation_ip)
+ set row(modifying_user) $obj(modifying_user)
+ set row(last_modified) $obj(last_modified_ansi)
+ set row(modifying_ip) $obj(modifying_ip)
+ return [array get row]
+}
+
ad_proc -public chat_room_new {
{-description ""}
{-moderated_p f}
{-active_p t}
{-archive_p f}
{-auto_flush_p t}
{-auto_transcript_p f}
+ {-login_messages_p t}
+ {-logout_messages_p t}
+ {-messages_time_window 600}
{-context_id ""}
{-creation_user ""}
{-creation_ip ""}
pretty_name
-
} {
Create new chat room. Return room_id if successful else raise error.
} {
+ if {[ad_conn isconnected] && $creation_user eq ""} {
+ set creation_user [ad_conn user_id]
+ }
db_transaction {
- set room_id [db_exec_plsql create_room {}]
- }
+ set room_id [::xo::db::sql::acs_object new \
+ -object_type "chat_room" \
+ -creation_user $creation_user \
+ -creation_ip $creation_ip \
+ -context_id $context_id]
- db_exec_plsql grant_permission {}
+ db_dml insert_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
+ }
+ }
+
return $room_id
}
+ad_proc -public chat_room_exists_p {
+ room_id
+} {
+ Return whether a chat room exists
+
+ @return a boolean
+} {
+ if {[ns_cache_keys -exact -- chat_room_cache $room_id] ne ""} {
+ # chat room is in cache: it exists "for sure"
+ return 1
+ } elseif {[info exists ::chat_room_deleted_p($room_id)]} {
+ # chat room deletion has been recorded in threaded cache: as
+ # object id comes from a sequence, unless somebody puts an id
+ # by hand, the same will never be used again system wide, so
+ # it is safe to cache this
+ return 0
+ } elseif {[db_0or1row room_exists {
+ select 1 from chat_rooms
+ where room_id = :room_id}]} {
+ # chat room existance has been confirmed by query
+ return 1
+ } else {
+ # chat room is not there: take note of this in threaded cache
+ set ::chat_room_deleted_p($room_id) 1
+ return 0
+ }
+}
+
ad_proc -public chat_room_edit {
room_id
pretty_name
@@ -180,56 +292,61 @@
archive_p
auto_flush_p
auto_transcript_p
+ login_messages_p
+ logout_messages_p
+ messages_time_window
} {
Edit information on chat room. All information require.
} {
- db_exec_plsql edit_room {}
+ db_dml update_room {}
+ ns_cache_flush -- chat_room_cache $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_cache $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}]
-
+ if {[chat_room_exists_p $room_id]} {
+ chat_room_get -room_id $room_id -array c
+ return [expr {$c(active_p) ne "" ? $c(active_p) : "f"}]
+ } else {
+ return "f"
+ }
}
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 {
@@ -238,7 +355,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 {
@@ -247,9 +367,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 {
@@ -259,19 +380,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}
+ }
}
}
@@ -281,21 +411,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 {
@@ -305,39 +436,30 @@
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 {
user_id
} {
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)}]
+ acs_user::get -user_id $user_id -array user
+ set name [expr {$user(screen_name) ne "" ? $user(screen_name) : $user(name)}]
return $name
-
}
ad_proc -public chat_message_post {
@@ -348,41 +470,39 @@
} {
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"
}
- set default_client [parameter::get -parameter "DefaultClient" -default "ajax"]
+ set default_client [parameter::get -parameter "DefaultClient" -default "ajax"]
- 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) == "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"
- }
+ # 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
message
} {
Post moderate message to the chat room and broadcast to all applet clients. Only use by HTML client.
} {
- set chat_msg "[chat_user_name $user_id]$user_id$room_id$messagepending"
+ set chat_msg "
+
+ [chat_user_name $user_id]
+ $user_id
+ $room_id
+ $message
+ pending
+ "
# Add message to queue. Notify thread responsible for broadcast message to applets.
nsv_set chat html_message $chat_msg
@@ -394,20 +514,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.
+ # 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]} {
- nsv_set chat_room $room_id [list "[chat_user_name $user_id]$room_id[_ chat.has_entered_the_room]approved"]
+ nsv_set chat_room $room_id {}
}
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]
@@ -416,16 +537,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
@@ -439,10 +559,8 @@
return
}
}
-
}
-
ad_proc -public chat_transcript_new {
{-description ""}
{-context_id ""}
@@ -454,25 +572,36 @@
} {
Create chat transcript.
} {
+ if {[ad_conn isconnected] && $creation_user eq ""} {
+ set creation_user [ad_conn user_id]
+ }
db_transaction {
- set transcript_id [db_exec_plsql create_transcript {}]
- if { $transcript_id ne 0 } {
- db_dml update_contents {}
- db_exec_plsql grant_permission {}
+ set transcript_id [::xo::db::sql::acs_object new \
+ -object_type "chat_transcript" \
+ -creation_user $creation_user \
+ -creation_ip $creation_ip \
+ -context_id $context_id]
+
+ db_dml insert_transcript {}
+
+ 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 {
@@ -483,54 +612,43 @@
} {
Edit chat transcript.
} {
- db_exec_plsql edit_transcript {}
- db_dml update_contents {}
+ db_dml update_transcript {}
}
-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 $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
+ set user_name [expr {$creation_user > 0 ? [chat_user_name $creation_user] : "system"}]
+ lappend contents "\[$creation_date\] ${user_name}: $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
}
}
-