Index: openacs-4/packages/chat/chat.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/chat.info,v
diff -u -N -r1.22.2.3 -r1.22.2.4
--- openacs-4/packages/chat/chat.info 28 Feb 2019 16:09:03 -0000 1.22.2.3
+++ openacs-4/packages/chat/chat.info 1 Mar 2019 17:25:59 -0000 1.22.2.4
@@ -9,16 +9,20 @@
f
t
-
+
Peter Alberer
Server based chat with an html and ajax client.
- 2019-01-18
+ 2019-03-01
OpenACS
- Adapted by Peter Alberer 2006/03/25 to allow java and ajax to coexist.
-Adapted by Tekne 2006/03/01 to replace JAVA server with AJAX; make use of generalized chat class from xotcl-core.
+
+ Adapted by Peter Alberer 2006/03/25 to allow java and ajax to coexist.
+ Adapted by Tekne 2006/03/01 to replace JAVA server with AJAX; make use of generalized chat class from xotcl-core.
+ Adapted by Antonio Pisano circa 2016-2019 to reduce bloating and exploit xotcl ORM and server push capabilities. Java server was discontinued in the process.
+ Adapted by Hector Romojaro Gomez 2018-2019 to give a modern look and feel, customizable skins and avatar picture.
+
0
-
+
Index: openacs-4/packages/chat/sql/oracle/chat-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/sql/oracle/chat-create.sql,v
diff -u -N -r1.5.2.3 -r1.5.2.4
--- openacs-4/packages/chat/sql/oracle/chat-create.sql 28 Feb 2019 16:09:03 -0000 1.5.2.3
+++ openacs-4/packages/chat/sql/oracle/chat-create.sql 1 Mar 2019 17:25:59 -0000 1.5.2.4
@@ -69,190 +69,3 @@
end;
/
show errors
-
-
-declare
- attr_id acs_attributes.attribute_id%TYPE;
-begin
- -- create chat room object type
- acs_object_type.create_type (
- supertype => 'acs_object',
- object_type => 'chat_room',
- pretty_name => 'Chat Room',
- pretty_plural => 'Chat Rooms',
- table_name => 'CHAT_ROOMS',
- id_column => 'ROOM_ID'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'pretty_name',
- pretty_name => 'Room name',
- pretty_plural => 'Room names',
- datatype => 'string'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'description',
- pretty_name => 'Description',
- pretty_plural => 'Descriptions',
- datatype => 'string'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'moderated_p',
- pretty_name => 'Moderated',
- pretty_plural => 'Moderated',
- datatype => 'boolean'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'active_p',
- pretty_name => 'Activated',
- pretty_plural => 'Activated',
- datatype => 'boolean'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'archive_p',
- pretty_name => 'Archived',
- pretty_plural => 'Archived',
- datatype => 'boolean'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_room',
- attribute_name => 'avatar_p',
- pretty_name => 'Avatar',
- pretty_plural => 'Avatars',
- datatype => 'boolean'
- );
-end;
-/
-show errors;
-
-create table chat_rooms (
- room_id integer
- constraint chat_rooms_room_id_pk primary key
- constraint chat_rooms_room_id_fk
- references acs_objects(object_id) on delete cascade,
- -- This is room name.
- pretty_name varchar2(100)
- constraint chat_rooms_pretty_name_nn not null,
- description varchar2(2000),
- moderated_p char(1) default 'f'
- constraint chat_rooms_moderate_p_ck
- check (moderated_p in ('t','f')),
- active_p char(1) default 't'
- constraint chat_rooms_active_p_ck
- check (active_p in ('t','f')),
- -- if set then log all chat messages in this room.
- archive_p char(1) default 'f'
- constraint chat_rooms_archive_p_ck
- check (archive_p in ('t', 'f')),
- auto_flush_p char(1) default 't'
- constraint chat_rooms_auto_flush_ck
- check (auto_flush_p in ('t', 'f')),
- auto_transcript_p char(1) default 'f'
- constraint chat_rooms_auto_transcript_ck
- check (auto_transcript_p in ('t', 'f')),
- login_messages_p char(1) default 't'
- constraint chat_rooms_login_messages_ck
- check (login_messages_p in ('t', 'f')),
- logout_messages_p char(1) default 't'
- constraint chat_rooms_logout_messages_ck
- check (logout_messages_p in ('t', 'f')),
- -- set how much in the past users will see when entering a chat in
- -- seconds this is needed to specify, for example, that users will
- -- see only the previous 10 minutes of the conversation
- messages_time_window integer default 600,
- avatar_p char(1) default 't'
- constraint chat_rooms_avatar_p_ck
- check (avatar_p in ('t', 'f'))
-);
-
-declare
- attr_id acs_attributes.attribute_id%TYPE;
-begin
- -- create chat transcript object type
- acs_object_type.create_type (
- supertype => 'acs_object',
- object_type => 'chat_transcript',
- pretty_name => 'Chat Transcript',
- pretty_plural => 'Chat Transcripts',
- table_name => 'CHAT_TRANSCRIPTS',
- id_column => 'TRANSCRIPT_ID'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_transcript',
- attribute_name => 'pretty_name',
- pretty_name => 'Transcript name',
- pretty_plural => 'Transcript names',
- datatype => 'string'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_transcript',
- attribute_name => 'description',
- pretty_name => 'Description',
- pretty_plural => 'Descriptions',
- datatype => 'string'
- );
-
- attr_id := acs_attribute.create_attribute (
- object_type => 'chat_transcript',
- attribute_name => 'contents',
- pretty_name => 'Transcript content',
- pretty_plural => 'Transcript contents',
- datatype => 'string'
- );
-end;
-/
-show errors
-
-create table chat_transcripts (
- transcript_id integer
- constraint chat_trans_transcript_id_pk primary key
- constraint chat_trans_transcript_id_fk
- references acs_objects(object_id) on delete cascade,
- contents clob
- constraint chat_trans_contents_nn not null,
- -- Chat transcript name.
- pretty_name varchar2(100)
- constraint chat_trans_pretty_name_nn not null,
- description varchar2(2000),
- room_id integer
- constraint chat_trans_room_id_fk
- references chat_rooms(room_id) on delete cascade
-);
-
-create table chat_msgs (
- msg_id integer
- constraint chat_msgs_msg_id_pk primary key,
- msg varchar2(4000),
- msg_len integer
- constraint chat_msgs_msg_len_ck
- check (msg_len >= 0),
- html_p char(1) default 'f'
- constraint chat_msgs_html_p_ck
- check (html_p in ('t','f')),
- approved_p char(1) default 't'
- constraint chat_msgs_approve_p_ck
- check(approved_p in ('t','f')),
- creation_user integer
- constraint chat_msgs_creation_user_fk
- references parties(party_id) on delete cascade
- constraint chat_msgs_creation_user_nn not null,
- creation_ip varchar2(50) ,
- creation_date date
- constraint chat_msgs_creation_date_nn not null,
- room_id integer
- constraint chat_msgs_room_id_fk
- references chat_rooms(room_id) on delete cascade
-);
-
Index: openacs-4/packages/chat/sql/postgresql/chat-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/sql/postgresql/chat-create.sql,v
diff -u -N -r1.10.2.3 -r1.10.2.4
--- openacs-4/packages/chat/sql/postgresql/chat-create.sql 28 Feb 2019 16:09:03 -0000 1.10.2.3
+++ openacs-4/packages/chat/sql/postgresql/chat-create.sql 1 Mar 2019 17:25:59 -0000 1.10.2.4
@@ -65,292 +65,3 @@
-- Site wite admin also administrator of the chat room.
select acs_privilege__add_child('admin', 'chat_room_admin');
-
-
--- create chat room object type
-CREATE FUNCTION inline_0() returns integer
-AS 'declare
- attr_id acs_attributes.attribute_id%TYPE;
- begin
- PERFORM
-
- acs_object_type__create_type(
- ''chat_room'', -- object_type
- ''Chat Room'', -- pretty_name
- ''Chat Rooms'', -- pretty_plural
- ''acs_object'', -- supertype
- ''chat_rooms'', -- table_name
- ''room_id'', -- id_column
- null, -- package_name
- ''f'', -- abstract_p
- null, -- type_extension_table
- null -- name_method
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''pretty_name'', -- attribute_name
- ''string'', -- datatype
- ''Room name'', -- pretty_name
- ''Room names'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''description'', -- attribute_name
- ''string'', -- datatype
- ''Description'', -- pretty_name
- ''Descriptions'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''moderated_p'', -- attribute_name
- ''boolean'', -- datatype
- ''Moderated'', -- pretty_name
- ''Moderated'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''active_p'', -- attribute_name
- ''boolean'', -- datatype
- ''Activated'', -- pretty_name
- ''Activated'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''archive_p'', -- attribute_name
- ''boolean'', -- datatype
- ''Archived'', -- pretty_name
- ''Archived'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_room'', -- object_type
- ''avatar_p'', -- attribute_name
- ''boolean'', -- datatype
- ''Avatar'', -- pretty_name
- ''Avatars'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- ''t'', -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- return 0;
-
- end;'
-
-language 'plpgsql';
-SELECT inline_0();
-DROP function inline_0();
-
-
-create table chat_rooms (
-
- room_id integer
- constraint chat_rooms_room_id_pk primary key
- constraint chat_rooms_room_id_fk
- references acs_objects(object_id) on delete cascade,
- -- This is room name.
- pretty_name varchar(100)
- constraint chat_rooms_pretty_name_nn not null,
- description varchar(2000),
- moderated_p boolean
- default 'f'
- constraint chat_rooms_moderate_p_ck
- check (moderated_p in ('t','f')),
- active_p boolean
- default 't'
- constraint chat_rooms_active_p_ck
- check (active_p in ('t','f')),
- -- if set then log all chat messages in this room.
- archive_p boolean
- default 't'
- constraint chat_rooms_archive_p_ck
- check (archive_p in ('t', 'f')),
- -- flush the rooms messages every night at 00:05
- auto_flush_p boolean default 't',
- -- automatically create a transcript after flushing the room
- auto_transcript_p boolean default 'f',
- -- allow to set whether we want login/logout messages or not
- login_messages_p boolean default 't',
- logout_messages_p boolean default 't',
- -- set how much in the past users will see when entering a chat in
- -- seconds this is needed to specify, for example, that users will
- -- see only the previous 10 minutes of the conversation
- messages_time_window integer default 600,
- -- if set, display user avatars in the chat room
- avatar_p boolean default 't'
-);
-
-
--- create chat transcript object type
-CREATE FUNCTION inline_0() returns integer
-AS 'declare
- attr_id acs_attributes.attribute_id%TYPE;
- begin
- PERFORM
-
- acs_object_type__create_type(
- ''chat_transcript'', -- object_type
- ''Chat Transcript'', -- pretty_name
- ''Chat Transcripts'', -- pretty_plural
- ''acs_object'', -- supertype
- ''chat_transcripts'', -- table_name
- ''transcript_id'', -- id_column
- null, -- package_name
- ''f'', -- abstract_p
- null, -- type_extension_table
- null -- name_method
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_transcript'', -- object_type
- ''pretty_name'', -- attribute_name
- ''string'', -- datatype
- ''Transcript name'', -- pretty_name
- ''Transcript names'',-- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_transcript'', -- object_type
- ''description'', -- attribute_name
- ''string'', -- datatype
- ''Description'', -- pretty_name
- ''Descriptions'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- attr_id := acs_attribute__create_attribute (
- ''chat_transcript'', -- object_type
- ''contents'', -- attribute_name
- ''string'', -- datatype
- ''Transcript content'', -- pretty_name
- ''Transcript contents'', -- pretty_plural
- null, -- table_name (default)
- null, -- column_name (default)
- null, -- default_value (default)
- 1, -- min_n_values (default)
- 1, -- max_n_values (default)
- null, -- sort_order (default)
- ''type_specific'', -- storage (default)
- ''f'' -- static_p (default)
- );
-
- return 0;
-
- end;'
-
-language 'plpgsql';
-SELECT inline_0();
-DROP function inline_0();
-
-
----------------------------------
-
-create table chat_transcripts (
- transcript_id integer
- constraint chat_trans_transcript_id_pk primary key
- constraint chat_trans_transcript_id_fk
- references acs_objects(object_id) on delete cascade,
- contents varchar(32000)
- constraint chat_trans_contents_nn not null,
- -- Chat transcript name.
- pretty_name varchar(100)
- constraint chat_trans_pretty_name_nn not null,
- description varchar(2000),
- room_id integer
- constraint chat_trans_room_id_fk
- references chat_rooms(room_id) on delete cascade
-);
-
-
----------------------------------
-
-create table chat_msgs (
- msg_id integer
- constraint chat_msgs_msg_id_pk primary key,
- msg varchar(4000),
- msg_len integer
- constraint chat_msgs_msg_len_ck
- check (msg_len >= 0),
- html_p boolean
- default 'f'
- constraint chat_msgs_html_p_ck
- check (html_p in ('t','f')),
- approved_p boolean
- default 't'
- constraint chat_msgs_approve_p_ck
- check(approved_p in ('t','f')),
- creation_user integer
- constraint chat_msgs_creation_user_fk
- references parties(party_id) on delete cascade
- constraint chat_msgs_creation_user_nn not null,
- creation_ip varchar(50) ,
- creation_date timestamptz,
- room_id integer
- constraint chat_msgs_room_id_fk
- references chat_rooms(room_id) on delete cascade
-);
Index: openacs-4/packages/chat/sql/postgresql/chat-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/sql/postgresql/chat-drop.sql,v
diff -u -N -r1.5.2.3 -r1.5.2.4
--- openacs-4/packages/chat/sql/postgresql/chat-drop.sql 28 Feb 2019 16:09:03 -0000 1.5.2.3
+++ openacs-4/packages/chat/sql/postgresql/chat-drop.sql 1 Mar 2019 17:26:00 -0000 1.5.2.4
@@ -6,45 +6,13 @@
-- @cvs-id $Id$
--
- --drop objects
-
-
-
--
--- procedure inline_0/0
+-- Drop chat_room object types and tables
--
-CREATE OR REPLACE FUNCTION inline_0(
+select acs_object_type__drop_type('chat_transcript','t', 't');
+select acs_object_type__drop_type('chat_room','t', 't');
-) RETURNS integer AS $$
-DECLARE
- object_rec record;
-BEGIN
- for object_rec in select object_id from acs_objects where object_type='chat_transcript'
- loop
- PERFORM acs_object__delete( object_rec.object_id );
- end loop;
-
- for object_rec in select object_id from acs_objects where object_type='chat_room'
- loop
- PERFORM acs_object__delete( object_rec.object_id );
- end loop;
- return 0;
-END;
-$$ LANGUAGE plpgsql;
-
-select inline_0 ();
-drop function inline_0 ();
-
-
---
--- Drop chat_room object type
---
-select acs_object_type__drop_type('chat_room','t');
-select acs_object_type__drop_type('chat_transcript','t');
-
drop table chat_msgs;
-drop table chat_transcripts;
-drop table chat_rooms;
--
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.24.2.4 -r1.24.2.5
--- openacs-4/packages/chat/tcl/chat-procs.tcl 1 Mar 2019 15:38:23 -0000 1.24.2.4
+++ openacs-4/packages/chat/tcl/chat-procs.tcl 1 Mar 2019 17:26:00 -0000 1.24.2.5
@@ -1,7 +1,11 @@
# /chat/tcl/chat-procs.tcl
ad_library {
- TCL Library for the chat system v.4
+ TCL Library for the chat system v.6
+ These procs serve now only as a backward compatibility layer, as
+ all the relevant logic is implemented in xotcl-chat-procs. These
+ procs will soon be deprecated.
+
@author David Dao (ddao@arsdigita.com)
@creation-date November 17, 2000
@cvs-id $Id$
@@ -15,26 +19,8 @@
} {
Log chat message to the database.
} {
- chat_room_get -room_id $room_id -array c
- if {$c(archive_p)} {
- set msg_id [db_nextval acs_object_id_seq]
- db_dml save_message {
- insert into chat_msgs (
- msg_id,
- room_id,
- msg,
- creation_user,
- creation_ip,
- creation_date)
- values (
- :msg_id,
- :room_id,
- :msg,
- :creation_user,
- :creation_ip,
- current_timestamp)
- }
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r post_message -creation_user $creation_user -creation_ip $creation_ip -msg $msg
}
ad_proc -public chat_room_get {
@@ -47,22 +33,22 @@
array set row [ns_cache eval chat_room_cache $room_id {
chat_room_get_not_cached $room_id
}]
+ #array set row [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
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ foreach var [$r info vars] {
+ set row($var) [$r set $var]
}
+ # todo: extend oo machinery so these attributes are also returned
+ # by get_instance_from_db
acs_object::get \
-object_id $room_id \
-array obj
+ set row(object_id) $obj(object_id)
set row(context_id) $obj(context_id)
set row(creation_user) $obj(creation_user)
set row(creation_date) $obj(creation_date_ansi)
@@ -91,34 +77,22 @@
} {
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 [::xo::db::sql::acs_object new \
- -object_type "chat_room" \
- -creation_user $creation_user \
- -creation_ip $creation_ip \
- -context_id $context_id]
-
- 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
+ set r [::xo::db::chat_room new \
+ -description $description \
+ -moderated_p $moderated_p \
+ -active_p $active_p \
+ -archive_p $archive_p \
+ -auto_flush_p $auto_flush_p \
+ -auto_transcript_p $auto_transcript_p \
+ -login_messages_p $login_messages_p \
+ -logout_messages_p $logout_messages_p \
+ -messages_time_window $messages_time_window \
+ -avatar_p $avatar_p \
+ -pretty_name $pretty_name]
+ $r set context_id $context_id
+ $r set creation_user $creation_user
+ $r set creation_ip $creation_ip
+ return [$r save_new]
}
ad_proc -public chat_room_exists_p {
@@ -128,25 +102,7 @@
@return a boolean
} {
- if {[ns_cache names 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 existence 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
- }
+ return [::xo::db::Class exists_in_db -id $room_id]
}
ad_proc -public chat_room_edit {
@@ -165,61 +121,62 @@
} {
Edit information on chat room. All information require.
} {
- db_dml update_room {}
- ns_cache flush chat_room_cache $room_id
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ foreach var {
+ pretty_name
+ description
+ moderated_p
+ active_p
+ archive_p
+ auto_flush_p
+ auto_transcript_p
+ login_messages_p
+ logout_messages_p
+ messages_time_window
+ avatar_p
+ } {
+ $r set $var [set $var]
+ }
+ $r save
}
ad_proc -public chat_room_delete {
room_id
} {
Delete chat room.
} {
- # Delete the transcripts explicitly, otherwise the acs_object
- # related to them would stay around
- foreach transcript_id [db_list get_transcripts {
- select transcript_id from chat_transcripts
- where room_id = :room_id
- }] {
- ::xo::db::sql::acs_object delete \
- -object_id $transcript_id
- }
- ::xo::db::sql::acs_object delete \
- -object_id $room_id
- ns_cache flush -- chat_room_cache $room_id
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r delete
}
ad_proc -public chat_room_message_delete {
room_id
} {
Delete all message in the room.
} {
- db_dml delete_message {
- delete from chat_msgs
- where room_id = :room_id
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r delete_messages
}
ad_proc -public chat_message_count {
room_id
} {
Get message count in the room.
} {
- return [db_string message_count {
- select count(*) from chat_msgs
- where room_id = :room_id
- } -default 0]
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r count_messages
}
ad_proc -public room_active_status {
room_id
} {
Get room active status.
} {
- 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"}]
+ if {[::xo::db::Class exists_in_db -id $room_id]} {
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ return [string is true -strict [$r set active_p]]
} else {
- return "f"
+ return false
}
}
@@ -228,8 +185,8 @@
} {
Get chat room name.
} {
- chat_room_get -room_id $room_id -array c
- return $c(pretty_name)
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ return [$r set pretty_name]
}
ad_proc -public chat_moderator_grant {
@@ -238,10 +195,8 @@
} {
Grant party a chat moderate privilege to this chat room.
} {
- permission::grant \
- -party_id $party_id \
- -object_id $room_id \
- -privilege "chat_room_moderate"
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r grant_moderator -party_id $party_id
}
ad_proc -public chat_moderator_revoke {
@@ -250,10 +205,8 @@
} {
Revoke party a chat moderate privilege to this chat room.
} {
- permission::revoke \
- -party_id $party_id \
- -object_id $room_id \
- -privilege "chat_room_moderate"
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r revoke_moderator -party_id $party_id
}
ad_proc -public chat_user_grant {
@@ -262,14 +215,8 @@
} {
Grant party a chat privilege to this chat room.
} {
- db_transaction {
- foreach privilege {read write} {
- permission::grant \
- -party_id $party_id \
- -object_id $room_id \
- -privilege chat_${privilege}
- }
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r grant_user -party_id $party_id
}
ad_proc -public chat_user_revoke {
@@ -278,14 +225,8 @@
} {
Revoke party a chat privilege to this chat room.
} {
- db_transaction {
- foreach privilege {read write} {
- permission::revoke \
- -party_id $party_id \
- -object_id $room_id \
- -privilege chat_${privilege}
- }
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r revoke_user -party_id $party_id
}
ad_proc -public chat_user_ban {
@@ -294,10 +235,8 @@
} {
Explicit ban user from this chat room.
} {
- permission::grant \
- -party_id $party_id \
- -object_id $room_id \
- -privilege "chat_ban"
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r ban_user -party_id $party_id
}
ad_proc -public chat_user_unban {
@@ -306,10 +245,8 @@
} {
unban user from this chat room.
} {
- permission::revoke \
- -party_id $party_id \
- -object_id $room_id \
- -privilege "chat_ban"
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r unban_user -party_id $party_id
}
ad_proc -public chat_revoke_moderators {
@@ -318,33 +255,25 @@
} {
Revoke a list of parties of a moderate privilege from this room.
} {
- foreach party_id $revoke_list {
- permission::revoke \
- -party_id $party_id \
- -object_id $room_id \
- -privilege "chat_moderate_room"
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r revoke_moderator -party_id $revoke_list
}
ad_proc -public chat_room_moderate_p {
room_id
} {
Return the moderate status of this chat room.
} {
- chat_room_get -room_id $room_id -array c
- return $c(moderated_p)
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ return [$r set moderated_p]
}
ad_proc -public chat_user_name {
user_id
} {
Return display name of this user to use in chat.
} {
- 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
+ return [::chat::Package get_user_name -user_id $user_id]
}
ad_proc -public chat_message_post {
@@ -355,20 +284,8 @@
} {
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"
- }
-
- # 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"
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r post_message -msg $message -creation_user $user_id
}
ad_proc -public chat_transcript_new {
@@ -382,28 +299,15 @@
} {
Create chat transcript.
} {
- if {[ad_conn isconnected] && $creation_user eq ""} {
- set creation_user [ad_conn user_id]
- }
-
- db_transaction {
- 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
+ set t [::xo::db::chat_transcript new \
+ -description $description \
+ -pretty_name $pretty_name \
+ -contents $contents \
+ -room_id $room_id]
+ $t set context_id $context_id
+ $t set creation_user $creation_user
+ $t set creation_ip $creation_ip
+ return [$t save_new]
}
ad_proc -public chat_transcript_delete {
@@ -423,45 +327,30 @@
} {
Edit chat transcript.
} {
- db_dml update_transcript {}
+ set t [::xo::db::Class get_instance_from_db -id $transcript_id]
+ foreach var {
+ pretty_name
+ description
+ contents
+ } {
+ $t set $var [set $var]
+ }
+ $t save
}
ad_proc -private chat_flush_rooms {} {
Flush the messages in all of the chat rooms
} {
- set room_ids [db_list get_rooms *SQL*]
- foreach room_id $room_ids {
- chat_room_flush $room_id
- }
+ ::chat::Package flush_rooms
}
ad_proc -private chat_room_flush {
room_id
} {
Flush the messages a single chat room
} {
- db_transaction {
- 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
- 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# $today" \
- [join $contents "
\n"] $room_id
- }
- }
- # clear all the messages in the room
- chat_room_message_delete $room_id
- }
+ set r [::xo::db::Class get_instance_from_db -id $room_id]
+ $r flush
}
# Local variables:
Index: openacs-4/packages/chat/tcl/xotcl-chat-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/chat/tcl/Attic/xotcl-chat-procs.tcl,v
diff -u -N
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/chat/tcl/xotcl-chat-procs.tcl 1 Mar 2019 17:26:00 -0000 1.1.2.1
@@ -0,0 +1,336 @@
+::xo::library doc {
+
+ Chat Objects
+
+ @author Antonio Pisano
+
+}
+
+namespace eval ::chat {
+
+ #
+ ## Chat Package
+ #
+
+ Class create ::chat::Package
+
+ ::chat::Package proc flush_rooms {} {
+ foreach room_id [::xo::dc list get_rooms {
+ select room_id from chat_rooms
+ where archive_p and auto_flush_p
+ }] {
+ set room [::xo::db::Class get_instance_from_db -id $room_id]
+ $room flush
+ }
+ }
+
+ ::chat::Package proc get_user_name {-user_id} {
+ 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 moderated_p \
+ -datatype boolean -default false
+ ::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 instproc grant_creator {} {
+ 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 instproc grant_user {
+ -party_id
+ } {
+ ::xo::dc transaction {
+ foreach privilege {read write} {
+ permission::grant \
+ -party_id $party_id \
+ -object_id ${:room_id} \
+ -privilege chat_${privilege}
+ }
+ }
+ }
+
+ ::xo::db::chat_room instproc revoke_user {
+ -party_id
+ } {
+ ::xo::dc transaction {
+ foreach privilege {read write} {
+ permission::revoke \
+ -party_id $party_id \
+ -object_id ${:room_id} \
+ -privilege chat_${privilege}
+ }
+ }
+ }
+
+ ::xo::db::chat_room instproc ban_user {
+ -party_id
+ } {
+ permission::grant \
+ -party_id $party_id \
+ -object_id ${:room_id} \
+ -privilege chat_ban
+ }
+
+ ::xo::db::chat_room instproc unban_user {
+ -party_id
+ } {
+ permission::revoke \
+ -party_id $party_id \
+ -object_id ${:room_id} \
+ -privilege chat_ban
+ }
+
+ ::xo::db::chat_room instproc grant_moderator {
+ -party_id
+ } {
+ permission::grant \
+ -party_id $party_id \
+ -object_id ${:room_id} \
+ -privilege chat_room_moderate
+ }
+
+ ::xo::db::chat_room instproc revoke_moderator {
+ -party_id
+ } {
+ 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 instproc save_new {} {
+ if {![info exists :creation_user]} {
+ set :creation_user [expr {[ns_conn isconnected] ? [ad_conn user_id] : ""}]
+ }
+ if {![info exists :creation_ip]} {
+ set :creation_ip [expr {[ns_conn isconnected] ? [ad_conn peeraddr] : ""}]
+ }
+ if {![info exists :context_id]} {
+ set :context_id [expr {[ns_conn isconnected] ? [ad_conn package_id] : ""}]
+ }
+ set creation_user ${:creation_user}
+ set creation_ip ${:creation_ip}
+ set context_id ${:context_id}
+ ::xo::dc transaction {
+ set room_id [next]
+ # todo: changing the acs_object by hand might change if we
+ # would add these metadata to the acs_object orm in
+ # xotcl-core
+ ::xo::dc dml update {
+ update acs_objects set
+ creation_user = :creation_user
+ ,creation_ip = :creation_ip
+ ,context_id = :context_id
+ where object_id = :room_id
+ }
+ :grant_creator
+ }
+
+ return $room_id
+ }
+
+ ::xo::db::chat_room instproc delete {} {
+ set room_id ${:room_id}
+ foreach transcript_id [::xo::dc list get_transcripts {
+ select transcript_id from chat_transcripts
+ where room_id = :room_id
+ }] {
+ ::xo::db::sql::acs_object delete \
+ -object_id $transcript_id
+ }
+ next
+ }
+
+
+ ::xo::db::chat_room instproc post_message {
+ {-msg ""}
+ {-creation_user ""}
+ {-creation_ip ""}
+ } {
+ 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 instproc delete_messages {} {
+ set room_id ${:room_id}
+ ::xo::dc dml delete_messages {
+ delete from chat_msgs where room_id = :room_id
+ }
+ }
+
+ ::xo::db::chat_room instproc count_messages {} {
+ 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 instproc flush {} {
+ if {${:auto_transcript_p}} {
+ 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
+ } {
+ set user_name [expr {$creation_user > 0 ? [chat_user_name $creation_user] : "system"}]
+ lappend contents "\[$creation_date\] ${user_name}: $msg"
+ }
+ if {[llength $contents] > 0} {
+ set today [clock format [clock seconds] -format "%d.%m.%Y"]
+ set t [::xo::db::chat_transcript new \
+ -pretty_name "#chat.transcript_of_date# $today" \
+ -description "#chat.automatically_created_transcript#" \
+ -room_id ${:room_id} \
+ -contents [join $contents "
\n"]]
+ $t save_new
+ }
+ }
+ :delete_messages
+ }
+
+ #
+ ## 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::chat_transcript instproc save_new {} {
+ if {![info exists :creation_user]} {
+ set :creation_user [expr {[ns_conn isconnected] ? [ad_conn user_id] : ""}]
+ }
+ if {![info exists :creation_ip]} {
+ set :creation_ip [expr {[ns_conn isconnected] ? [ad_conn peeraddr] : ""}]
+ }
+ if {![info exists :context_id]} {
+ set :context_id [expr {[ns_conn isconnected] ? [ad_conn package_id] : ""}]
+ }
+ set creation_user ${:creation_user}
+ set creation_ip ${:creation_ip}
+ set context_id ${:context_id}
+ ::xo::dc transaction {
+ set transcript_id [next]
+ # todo: changing the acs_object by hand might change if we
+ # would add these metadata to the acs_object orm in
+ # xotcl-core
+ ::xo::dc dml update {
+ update acs_objects set
+ creation_user = :creation_user
+ ,creation_ip = :creation_ip
+ ,context_id = :context_id
+ where object_id = :transcript_id
+ }
+ foreach privilege {edit view delete} {
+ permission::grant \
+ -party_id ${:creation_user} \
+ -object_id ${:transcript_id} \
+ -privilege chat_transcript_${privilege}
+ }
+ }
+ return $transcript_id
+ }
+
+}