- Publicity: Public Only All
xotcl-chat-procs.tcl
Chat Objects
- Location:
- packages/chat/tcl/xotcl-chat-procs.tcl
- Author:
- Antonio Pisano
Procedures in this file
- chat::Package proc flush_rooms (public)
- chat::Package proc get_user_name (public)
- xo::db::chat_room instproc ban_user (public)
- xo::db::chat_room instproc count_messages (public)
- xo::db::chat_room instproc create_transcript (public)
- xo::db::chat_room instproc delete (public)
- xo::db::chat_room instproc delete_messages (public)
- xo::db::chat_room instproc flush (public)
- xo::db::chat_room instproc grant_creator (public)
- xo::db::chat_room instproc grant_moderator (public)
- xo::db::chat_room instproc grant_user (public)
- xo::db::chat_room instproc post_message (public)
- xo::db::chat_room instproc revoke_moderator (public)
- xo::db::chat_room instproc revoke_user (public)
- xo::db::chat_room instproc save_new (public)
- xo::db::chat_room instproc transcript_messages (public)
- xo::db::chat_room instproc unban_user (public)
- xo::db::chat_transcript instproc save_new (public)
Detailed information
chat::Package proc flush_rooms (public)
chat::Package flush_rooms
Flush every room supposed to be archived and automatically flushed. Meant to be executed in a scheduled procedure.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
chat::Package proc get_user_name (public)
chat::Package get_user_name -user_id user_id
Retrieves the username supposed to be displayed in the chat UI: aither the screen name or the person name when the former is missing.
- Switches:
- -user_id
(required)- Returns:
- a username
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc ban_user (public)
<instance of xo::db::chat_room> ban_user -party_id party_id
Bans specified user from the chat room
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc count_messages (public)
<instance of xo::db::chat_room> count_messages
Count messages currently persisted for this chat room.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc create_transcript (public)
<instance of xo::db::chat_room> create_transcript \ [ -pretty_name pretty_name ] [ -description description ] \ [ -creation_user creation_user ] [ -creation_ip creation_ip ]
Creates a new transcript of all current chat room messages.
- Switches:
- -pretty_name
(optional)- -description
(optional)- -creation_user
(optional)- -creation_ip
(optional)- Returns:
- transcript_id of the new transcript or 0 when no messages were in the chat room.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc delete (public)
<instance of xo::db::chat_room> delete args [ args... ]
Delete the chat room and all of its transcripts
- Parameters:
- args
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc delete_messages (public)
<instance of xo::db::chat_room> delete_messages
Delete all persisted messages from the chat room.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc flush (public)
<instance of xo::db::chat_room> flush
Save all currently persisted messages for this chat room as a new transcript and then delete them.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc grant_creator (public)
<instance of xo::db::chat_room> grant_creator
Grants operative privileges to the chat creator (when available on the chat room object). In detail the permissions to edit, view and delete the chat room and also to create transcripts of it.
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc grant_moderator (public)
<instance of xo::db::chat_room> grant_moderator \ -party_id party_id
Make specified party the chat room moderator
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc grant_user (public)
<instance of xo::db::chat_room> grant_user -party_id party_id
Grants operative privileges to the specified party. In detail, the permission to read and write for the chat room.
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc post_message (public)
<instance of xo::db::chat_room> post_message [ -msg msg ] \ [ -creation_user creation_user ] [ -creation_ip creation_ip ]
Post a message in the chat room. This actually means persisting the message in the database, but only if the chat room is configured to be archived.
- Switches:
- -msg
(optional)- the message
- -creation_user
(optional)- the alleged creation user of the persisted message. Won't be set automatically from the connection
- -creation_ip
(optional)- the alleged creation IP of the persisted message. Won't be set automatically from the connection
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc revoke_moderator (public)
<instance of xo::db::chat_room> revoke_moderator \ -party_id party_id
Revoke moderation rights on the chat room for specified party
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc revoke_user (public)
<instance of xo::db::chat_room> revoke_user -party_id party_id
Revokes operative privileges to the specified party. In detail, the permission to read and write for the chat room.
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc save_new (public)
<instance of xo::db::chat_room> save_new \ [ -creation_user creation_user ] args [ args... ]
Create a new chat room and make sure its creator is granted the necessary privileges
- Switches:
- -creation_user
(optional)- Parameters:
- args
- Returns:
- new chat room id
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc transcript_messages (public)
<instance of xo::db::chat_room> transcript_messages
Formats the current content of a chat room as a list of messages formatted so they can be displayed or stored in the transcript.
- Returns:
- list of formatted messages
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_room instproc unban_user (public)
<instance of xo::db::chat_room> unban_user -party_id party_id
Lift ban on specified user from the chat room
- Switches:
- -party_id
(required)- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
xo::db::chat_transcript instproc save_new (public)
<instance of xo::db::chat_transcript> save_new args [ args... ]
Save a new transcript, making sure its creator is granted the necessary operative privileges.
- Parameters:
- args
- Returns:
- new transcript id
- Partial Call Graph (max 5 caller/called nodes):
- Testcases:
- No testcase defined.
Content File Source
::xo::library doc { Chat Objects @author Antonio Pisano } namespace eval ::chat { # ## Chat Package # Class create ::chat::Package ::chat::Package ad_proc flush_rooms {} { Flush every room supposed to be archived and automatically flushed. Meant to be executed in a scheduled procedure. } { foreach room_id [::xo::dc list get_rooms { select room_id from chat_rooms where archive_p = 't' and auto_flush_p = 't' }] { set room [::xo::db::Class get_instance_from_db -id $room_id] $room flush } } ::chat::Package ad_proc get_user_name { -user_id:required } { Retrieves the username supposed to be displayed in the chat UI: aither the screen name or the person name when the former is missing. @return a username } { set name [acs_user::get_user_info -user_id $user_id -element screen_name] if {$name eq ""} { set name [person::name -person_id $user_id] } return $name } # ## Chat Room # ::xo::db::Class create ::xo::db::chat_room \ -id_column room_id \ -object_type "chat_room" \ -table_name "chat_rooms" \ -pretty_name "#chat.Room#" \ -pretty_plural "#chat.Rooms#" \ -superclass ::xo::db::Object -slots { ::xo::db::Attribute create pretty_name \ -sqltype varchar(100) -not_null true ::xo::db::Attribute create description \ -sqltype varchar(2000) ::xo::db::Attribute create active_p \ -datatype boolean -default true ::xo::db::Attribute create archive_p \ -datatype boolean -default true ::xo::db::Attribute create auto_flush_p \ -datatype boolean -default true ::xo::db::Attribute create auto_transcript_p \ -datatype boolean -default false ::xo::db::Attribute create login_messages_p \ -datatype boolean -default true ::xo::db::Attribute create logout_messages_p \ -datatype boolean -default true ::xo::db::Attribute create messages_time_window \ -datatype integer -default 600 ::xo::db::Attribute create avatar_p \ -datatype boolean -default true } ::xo::db::require table chat_msgs { msg_id {integer primary key} room_id {integer references chat_rooms(room_id) on delete cascade} msg {varchar(4000)} msg_len integer html_p {boolean default false} approved_p {boolean default true} creation_user {integer references parties(party_id) on delete cascade not null} creation_ip {varchar(50)} creation_date {timestamp with time zone} } ::xo::db::chat_room ad_instproc grant_creator {} { Grants operative privileges to the chat creator (when available on the chat room object). In detail the permissions to edit, view and delete the chat room and also to create transcripts of it. } { 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 } } ::xo::db::chat_room ad_instproc grant_user { -party_id:required } { Grants operative privileges to the specified party. In detail, the permission to read and write for the chat room. } { ::xo::dc transaction { foreach privilege {read write} { permission::grant \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_${privilege} } } } ::xo::db::chat_room ad_instproc revoke_user { -party_id:required } { Revokes operative privileges to the specified party. In detail, the permission to read and write for the chat room. } { ::xo::dc transaction { foreach privilege {read write} { permission::revoke \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_${privilege} } } } ::xo::db::chat_room ad_instproc ban_user { -party_id:required } { Bans specified user from the chat room } { permission::grant \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_ban } ::xo::db::chat_room ad_instproc unban_user { -party_id:required } { Lift ban on specified user from the chat room } { permission::revoke \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_ban } ::xo::db::chat_room ad_instproc grant_moderator { -party_id:required } { Make specified party the chat room moderator } { permission::grant \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_room_moderate } ::xo::db::chat_room ad_instproc revoke_moderator { -party_id:required } { Revoke moderation rights on the chat room for specified party } { set parties $party_id foreach party_id $parties { permission::revoke \ -party_id $party_id \ -object_id ${:room_id} \ -privilege chat_room_moderate } } ::xo::db::chat_room ad_instproc save_new { -creation_user args } { Create a new chat room and make sure its creator is granted the necessary privileges @return new chat room id } { if {![info exists :context_id]} { set :context_id ${:package_id} } # # save_new wants certain object metadata to be supplied # explicitly to the call. Here we pass them as arguments when # we detect them as instance variables. # set args [list] foreach var {package_id context_id creation_ip creation_user} { if {[info exists :${var}] && "-${var}" ni $args} { lappend args -${var} [set :${var}] } } ::xo::dc transaction { set room_id [next {*}$args] :grant_creator } return $room_id } ::xo::db::chat_room ad_instproc delete args { Delete the chat room and all of its transcripts } { set room_id ${:room_id} foreach transcript_id [::xo::dc list get_transcripts { select transcript_id from chat_transcripts where room_id = :room_id }] { ::acs::dc call acs_object delete \ -object_id $transcript_id } next } ::xo::db::chat_room ad_instproc post_message { {-msg ""} {-creation_user ""} {-creation_ip ""} } { Post a message in the chat room. This actually means persisting the message in the database, but only if the chat room is configured to be archived. @param msg the message @param creation_user the alleged creation user of the persisted message. Won't be set automatically from the connection @param creation_ip the alleged creation IP of the persisted message. Won't be set automatically from the connection } { if {!${:archive_p}} { return } set room_id ${:room_id} set message_id [db_nextval acs_object_id_seq] ::xo::dc dml save_message { insert into chat_msgs ( msg_id, room_id, msg, creation_user, creation_ip, creation_date) values ( :message_id, :room_id, :msg, :creation_user, :creation_ip, current_timestamp ) } } ::xo::db::chat_room ad_instproc delete_messages {} { Delete all persisted messages from the chat room. } { set room_id ${:room_id} ::xo::dc dml delete_messages { delete from chat_msgs where room_id = :room_id } } ::xo::db::chat_room ad_instproc count_messages {} { Count messages currently persisted for this chat room. } { set room_id ${:room_id} ::xo::dc get_value count_messages { select count(*) from chat_msgs where room_id = :room_id } } ::xo::db::chat_room ad_instproc flush {} { Save all currently persisted messages for this chat room as a new transcript and then delete them. } { if {${:auto_transcript_p}} { :create_transcript } :delete_messages } ::xo::db::chat_room ad_instproc create_transcript { -pretty_name -description -creation_user {-creation_ip ""} } { Creates a new transcript of all current chat room messages. @return transcript_id of the new transcript or 0 when no messages were in the chat room. } { if {![info exists pretty_name]} { set today [clock format [clock seconds] -format "%d.%m.%Y"] set pretty_name "#chat.transcript_of_date# $today" } if {![info exists description]} { set description "#chat.automatically_created_transcript#" } if {![info exists creation_user]} { set creation_user ${:creation_user} } set contents [:transcript_messages] if {[llength $contents] > 0} { set t [::xo::db::chat_transcript new -volatile \ -creation_user $creation_user \ -creation_ip $creation_ip \ -pretty_name $pretty_name \ -description $description \ -package_id ${:package_id} \ -room_id ${:room_id} \ -contents [join $contents \n]] $t save_new return [$t transcript_id] } else { return 0 } } ::xo::db::chat_room ad_instproc transcript_messages {} { Formats the current content of a chat room as a list of messages formatted so they can be displayed or stored in the transcript. @return list of formatted messages } { set room_id ${:room_id} set contents [list] ::xo::dc foreach get_archives_messages { select msg, creation_user, to_char(creation_date, 'DD.MM.YYYY hh24:mi:ss') as creation_date from chat_msgs where room_id = :room_id and msg is not null order by creation_date } { if {$creation_user > 0} { set user_name [::chat::Package get_user_name -user_id $creation_user] if {$user_name eq ""} { set user_name Unknown } } else { set user_name "system" } lappend contents "\[$creation_date\] ${user_name}: $msg" } return $contents } # ## Transcripts # ::xo::db::Class create ::xo::db::chat_transcript \ -id_column transcript_id \ -object_type "chat_transcript" \ -table_name "chat_transcripts" \ -pretty_name "#chat.Transcript#" \ -pretty_plural "#chat.Transcripts#" \ -superclass ::xo::db::Object -slots { ::xo::db::Attribute create pretty_name \ -sqltype varchar(100) -not_null true ::xo::db::Attribute create description \ -sqltype varchar(2000) ::xo::db::Attribute create contents \ -sqltype varchar(32000) -not_null true ::xo::db::Attribute create room_id \ -datatype integer \ -references "chat_rooms(room_id) on delete cascade" } ::xo::db::require index \ -table chat_transcripts -col room_id ::xo::db::chat_transcript ad_instproc save_new args { Save a new transcript, making sure its creator is granted the necessary operative privileges. @return new transcript id } { if {![info exists :context_id]} { set :context_id ${:package_id} } ::xo::dc transaction { set transcript_id [next] foreach privilege {edit view delete} { permission::grant \ -party_id ${:creation_user} \ -object_id ${:transcript_id} \ -privilege chat_transcript_${privilege} } } return $transcript_id } } # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End: