Index: openacs-4/contrib/packages/mailing-lists/mailing-lists.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/mailing-lists.info,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/mailing-lists.info 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,35 @@ + + + + + Mailing List + Mailing Lists + f + f + + + Timo Hentschel + ACS 4 mailing list package. + 2003-02-27 + Sussdorff-Roy + First version of mailing lists. + + + + + + + + + + + + + + + + + + + + Index: openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-create.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,311 @@ +-- use package vars for bounce manager (#of bounced emails to mark user +-- as bouncing, #of days of last mail sent unbounced so that bounce +-- history of user is deleted) and upper limit of attachment size + +begin + -- create the object types + + acs_object_type.create_type ( + supertype => 'acs_object', + object_type => 'mailing_list', + pretty_name => 'Mailing List', + pretty_plural => 'Mailing Lists', + table_name => 'ml_mailing_lists', + id_column => 'list_id', + name_method => 'ml_mailing_list.name' + ); + acs_object_type.create_type ( + supertype => 'acs_object', + object_type => 'mail_class', + pretty_name => 'Mailing Class', + pretty_plural => 'Mailing Classes', + table_name => 'ml_mail_classes', + id_column => 'mail_class_id', + name_method => 'ml_mail_class.name' + ); + acs_object_type.create_type ( + supertype => 'acs_object', + object_type => 'mail_job', + pretty_name => 'Mailing Job', + pretty_plural => 'Mailing Jobs', + table_name => 'ml_mail_jobs', + id_column => 'mail_job_id', + name_method => 'ml_mail_job.name' + ); +end; +/ +show errors + +begin + -- create the privileges + acs_privilege.create_privilege('mailing_list_admin', 'Mailing Lists Administrator'); + + acs_privilege.add_child('admin','mailing_list_admin'); +end; +/ +show errors + +create table ml_mailing_lists ( + list_id integer + constraint ml_mailing_lists_pk + primary key, + package_id integer + constraint ml_mailing_lists_pck_id_fk + references apm_packages, + name varchar2(1000) + constraint ml_mailing_lists_name_nn + not null, + locale varchar2(5) + constraint ml_mailing_lists_locale_nn + not null + constraint ml_mail_lists_locale_fk + references ad_locales, + teaser clob, + public_p char(1) default 't' + constraint ml_lists_public_p_ck + check (public_p in ('t','f')), + sender_email varchar2(1000), + confirm_subject varchar2(1000), + confirm_body clob, + confirm_mime_type varchar2(30) default 'text/plain', + welcome_subject varchar2(1000), + welcome_body clob, + welcome_mime_type varchar2(30) default 'text/plain', + remind_subject varchar2(1000), + remind_body clob, + remind_mime_type varchar2(30) default 'text/plain', + expiration_date date, + -- amount of days after sending registration email + first_reminder integer default 7, + -- 0 if no second reminder + second_reminder integer default 30, + comments clob +); + + +-- target, distribution and campaign: use categories (will be posted) + +create table ml_mailing_list_user_map ( + list_id integer + constraint ml_m_l_user_map_list_fk + references ml_mailing_lists + on delete cascade, + user_id integer + constraint ml_m_l_user_map_user_fk + references users + on delete cascade, + subscription_date date default sysdate, + unsubscription_date date, + subscribed_p char(1) default 't' + constraint ml_user_map_subscr_p_ck + check (subscribed_p in ('t','f')), + confirmed_p char(1) default 't' + constraint ml_user_map_confirm_p_ck + check (confirmed_p in ('t','f')), + reminder_count integer default 0, + constraint ml_mailing_list_user_map_pk + primary key (list_id, user_id) +); + +-- to speed up queries to get all lists for a user +create unique index ml_mailing_list_users_ix on ml_mailing_list_user_map (user_id, list_id); +create index ml_mail_list_users_subsc_p_ix on ml_mailing_list_user_map(subscribed_p); + + +create table ml_mail_classes ( + mail_class_id integer + constraint ml_mail_classes_pk + primary key, + package_id integer + constraint ml_mail_classes_pck_id_fk + references apm_packages, + name varchar2(1000) + constraint ml_mail_classes_name_nn + not null, + locale varchar2(5) + constraint ml_mail_classes_locale_nn + not null + constraint ml_mail_classes_locale_fk + references ad_locales, + public_p char(1) default 'f' + constraint ml_class_public_p_ck + check (public_p in ('t','f')), + sender_email varchar2(100), + subject varchar2(1000), + subject_change_p char(1) default 't' + constraint ml_class_subj_change_p_ck + check (subject_change_p in ('t','f')), + text_header clob, + text_header_change_p char(1) default 't' + constraint ml_class_t_head_change_p_ck + check (text_header_change_p in ('t','f')), + text_body clob, + text_body_change_p char(1) default 't' + constraint ml_class_t_body_change_p_ck + check (text_body_change_p in ('t','f')), + text_footer clob, + text_footer_change_p char(1) default 't' + constraint ml_class_t_foot_change_p_ck + check (text_footer_change_p in ('t','f')), + html_header clob, + html_header_change_p char(1) default 't' + constraint ml_class_h_head_change_p_ck + check (html_header_change_p in ('t','f')), + html_body clob, + html_body_change_p char(1) default 't' + constraint ml_class_h_body_change_p_ck + check (html_body_change_p in ('t','f')), + html_footer clob, + html_footer_change_p char(1) default 't' + constraint ml_class_h_foot_change_p_ck + check (html_footer_change_p in ('t','f')), + mime_type varchar2(30) default 'text/plain', + comments clob +); + +create table ml_mail_jobs ( + mail_job_id integer + constraint ml_mail_jobs_pk + primary key, + mail_class_id integer + constraint ml_mail_jobs_mail_class_id_fk + references acs_objects + on delete set null, + list_id integer + constraint ml_mail_jobs_list_id_fk + references acs_objects + on delete set null, + selection_id integer + constraint ml_mail_jobs_sel_id_fk + references acs_objects + on delete set null, + package_id integer + constraint ml_mail_jobs_package_id_fk + references apm_packages, + locale varchar2(5) + constraint ml_mail_jobs_locale_nn + not null + constraint ml_mail_jobs_locale_fk + references ad_locales, + sender_email varchar2(100), + track_links_p char(1) default 'f' + constraint ml_mail_jobs_track_p_ck + check (track_links_p in ('t','f')), + subject varchar2(1000), + text_header clob, + text_body clob, + text_footer clob, + html_header clob, + html_body clob, + html_footer clob, + template_p char(1) default 'f' + constraint ml_mail_jobs_template_p_ck + check (template_p in ('t','f')), + mime_type varchar2(30) default 'text/plain', + css_revision_id integer + constraint ml_mail_jobs_css_rev_id_fk + references cr_revisions on delete set null, + state varchar2(10), + scheduled_date date default sysdate, + execution_date date, + sql_query clob, + bind_vars varchar2(4000), + mails_sent integer default 0, + mails_bounced integer default 0 +); + +create index ml_jobs_scheduled_date_ix on ml_mail_jobs(scheduled_date); +create index ml_jobs_execution_date_ix on ml_mail_jobs(execution_date); + +create table ml_mail_job_bind_vars ( + mail_job_id integer + constraint ml_m_job_b_vars_job_id_fk + references ml_mail_jobs + on delete cascade, + name varchar2(30), + description varchar2(4000), + value varchar2(4000), + constraint ml_mail_job_bind_vars_pk + primary key (mail_job_id, name) +); + +-- make sure that this table doesn't fill up too much +-- i.e. delete all data older than 7 days + +create table ml_email_log ( + user_id integer + constraint ml_email_log_user_id_fk + references users, + mail_job_id integer + constraint ml_email_log_mail_job_id_fk + references ml_mail_jobs, + send_date date default sysdate, + constraint ml_email_log_pk + primary key (user_id, mail_job_id) +); + +create index ml_email_log_date_ix on ml_email_log(send_date); + +create table ml_user_email_log ( + user_id integer primary key + constraint ml_user_email_log_id_fk + references users, + last_mail_date date default null +); + +create index ml_user_email_log_date_ix on ml_user_email_log(last_mail_date); + +create table ml_bounce_log ( + mail_job_id integer + constraint ml_bounce_log_mail_job_id_fk + references ml_mail_jobs + on delete cascade, + user_id integer + constraint ml_bounce_log_user_id_fk + references users + on delete cascade, + sending_time date, + bouncing_time date default sysdate, + constraint ml_bounce_log_pk + primary key (mail_job_id, user_id) +); + +create index ml_bounce_log_bounce_time_ix on ml_bounce_log(bouncing_time); + +create table ml_category_trees_visible ( + tree_id integer + constraint ml_cat_trees_vis_tree_id_fk + references acs_objects + on delete cascade, + package_id integer + constraint ml_cat_trees_vis_pck_id_fk + references apm_packages, + constraint ml_cat_trees_vis_pk + primary key (package_id, tree_id) +); + +create table ml_country_category_tree ( + tree_id integer + constraint ml_country_category_tree_id_fk + references acs_objects + on delete cascade, + package_id integer + constraint ml_country_cat_tree_pck_id_fk + references apm_packages, + constraint ml_country_category_tree_pk + primary key (package_id, tree_id) +); + +create table ml_country_codes ( + country_code varchar2(3) + constraint ml_country_codes_pk + primary key, + category_id integer + constraint ml_country_codes_cat_id_fk + references acs_objects + on delete cascade +); + + +@@mailing-lists-package.sql +@@mailing-lists-init.sql Index: openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-drop.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-drop.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,55 @@ +drop package ml_mailing_list; +drop package ml_mail_class; +drop package ml_mail_job; + +drop table ml_country_codes; +drop table ml_country_category_tree; +drop table ml_category_trees_visible; +drop table ml_bounce_log; +drop table ml_user_email_log; +drop table ml_email_log; +drop table ml_mail_job_bind_vars; +drop table ml_mail_jobs; +drop table ml_mail_classes; +drop table ml_mailing_list_user_map; +drop table ml_mailing_lists; + +delete from acs_objects where object_type='mailing_list'; +delete from acs_objects where object_type='mail_class'; +delete from acs_objects where object_type='mail_job'; + +delete from acs_permissions +where privilege in ('mailing_list_admin'); + +delete from acs_privilege_hierarchy +where privilege in ('mailing_list_admin'); + +delete from acs_privilege_hierarchy +where child_privilege in ('mailing_list_admin'); + +delete from acs_privileges +where privilege in ('mailing_list_admin'); + +begin + acs_object_type.drop_type('mailing_list'); + acs_object_type.drop_type('mail_class'); + acs_object_type.drop_type('mail_job'); + + acs_sc_binding.delete( + contract_name => 'AcsObject', + impl_name => 'mailing_list_idhandler' + ); + acs_sc_impl.delete('AcsObject', 'mailing_list_idhandler'); + acs_sc_binding.delete( + contract_name => 'AcsObject', + impl_name => 'mail_class_idhandler' + ); + acs_sc_impl.delete('AcsObject', 'mail_class_idhandler'); + acs_sc_binding.delete( + contract_name => 'AcsObject', + impl_name => 'mail_job_idhandler' + ); + acs_sc_impl.delete('AcsObject', 'mail_job_idhandler'); +end; +/ +show errors Index: openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-init.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-init.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-init.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,56 @@ +declare + v_id integer; +begin + v_id := acs_sc_impl.new ( + 'AcsObject', + 'mailing_list_idhandler', + 'mailing-lists' + ); + v_id := acs_sc_impl.new_alias ( + 'AcsObject', + 'mailing_list_idhandler', + 'PageUrl', + 'ml_get_mailing_list_pageurl', + 'TCL' + ); + acs_sc_binding.new ( + contract_name => 'AcsObject', + impl_name => 'mailing_list_idhandler' + ); + + v_id := acs_sc_impl.new ( + 'AcsObject', + 'mail_class_idhandler', + 'mailing-lists' + ); + v_id := acs_sc_impl.new_alias ( + 'AcsObject', + 'mail_class_idhandler', + 'PageUrl', + 'ml_get_mail_class_pageurl', + 'TCL' + ); + acs_sc_binding.new ( + contract_name => 'AcsObject', + impl_name => 'mail_class_idhandler' + ); + + v_id := acs_sc_impl.new ( + 'AcsObject', + 'mail_job_idhandler', + 'mailing-lists' + ); + v_id := acs_sc_impl.new_alias ( + 'AcsObject', + 'mail_job_idhandler', + 'PageUrl', + 'ml_get_mail_job_pageurl', + 'TCL' + ); + acs_sc_binding.new ( + contract_name => 'AcsObject', + impl_name => 'mail_job_idhandler' + ); +end; +/ +show errors Index: openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-package.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-package.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-package.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,633 @@ +create or replace package ml_mailing_list +as + function new ( + list_id in ml_mailing_lists.list_id%TYPE default null, + package_id in ml_mailing_lists.package_id%TYPE default null, + name in ml_mailing_lists.name%TYPE, + locale in ml_mailing_lists.locale%TYPE, + teaser in ml_mailing_lists.teaser%TYPE default null, + sender_email in ml_mailing_lists.sender_email%TYPE default null, + confirm_subject in ml_mailing_lists.confirm_subject%TYPE default null, + confirm_body in ml_mailing_lists.confirm_body%TYPE default null, + confirm_mime_type in ml_mailing_lists.confirm_mime_type%TYPE default 'text/plain', + welcome_subject in ml_mailing_lists.welcome_subject%TYPE default null, + welcome_body in ml_mailing_lists.welcome_body%TYPE default null, + welcome_mime_type in ml_mailing_lists.welcome_mime_type%TYPE default 'text/plain', + remind_subject in ml_mailing_lists.remind_subject%TYPE default null, + remind_body in ml_mailing_lists.remind_body%TYPE default null, + remind_mime_type in ml_mailing_lists.remind_mime_type%TYPE default 'text/plain', + expiration_date in ml_mailing_lists.expiration_date%TYPE default sysdate, + first_reminder in ml_mailing_lists.first_reminder%TYPE default 7, + second_reminder in ml_mailing_lists.second_reminder%TYPE default 30, + comments in ml_mailing_lists.comments%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer; + + procedure delete ( + list_id in ml_mailing_lists.list_id%TYPE + ); + + procedure edit ( + list_id in ml_mailing_lists.list_id%TYPE default null, + name in ml_mailing_lists.name%TYPE, + locale in ml_mailing_lists.locale%TYPE, + teaser in ml_mailing_lists.teaser%TYPE default null, + sender_email in ml_mailing_lists.sender_email%TYPE default null, + confirm_subject in ml_mailing_lists.confirm_subject%TYPE default null, + confirm_body in ml_mailing_lists.confirm_body%TYPE default null, + confirm_mime_type in ml_mailing_lists.confirm_mime_type%TYPE default 'text/plain', + welcome_subject in ml_mailing_lists.welcome_subject%TYPE default null, + welcome_body in ml_mailing_lists.welcome_body%TYPE default null, + welcome_mime_type in ml_mailing_lists.welcome_mime_type%TYPE default 'text/plain', + remind_subject in ml_mailing_lists.remind_subject%TYPE default null, + remind_body in ml_mailing_lists.remind_body%TYPE default null, + remind_mime_type in ml_mailing_lists.remind_mime_type%TYPE default 'text/plain', + expiration_date in ml_mailing_lists.expiration_date%TYPE default sysdate, + first_reminder in ml_mailing_lists.first_reminder%TYPE default 7, + second_reminder in ml_mailing_lists.second_reminder%TYPE default 30, + comments in ml_mailing_lists.comments%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ); + + function name ( + list_id in ml_mailing_lists.list_id%TYPE + ) return varchar2; + +end ml_mailing_list; +/ +show errors + +create or replace package body ml_mailing_list +as + function new ( + list_id in ml_mailing_lists.list_id%TYPE default null, + package_id in ml_mailing_lists.package_id%TYPE default null, + name in ml_mailing_lists.name%TYPE, + locale in ml_mailing_lists.locale%TYPE, + teaser in ml_mailing_lists.teaser%TYPE default null, + sender_email in ml_mailing_lists.sender_email%TYPE default null, + confirm_subject in ml_mailing_lists.confirm_subject%TYPE default null, + confirm_body in ml_mailing_lists.confirm_body%TYPE default null, + confirm_mime_type in ml_mailing_lists.confirm_mime_type%TYPE default 'text/plain', + welcome_subject in ml_mailing_lists.welcome_subject%TYPE default null, + welcome_body in ml_mailing_lists.welcome_body%TYPE default null, + welcome_mime_type in ml_mailing_lists.welcome_mime_type%TYPE default 'text/plain', + remind_subject in ml_mailing_lists.remind_subject%TYPE default null, + remind_body in ml_mailing_lists.remind_body%TYPE default null, + remind_mime_type in ml_mailing_lists.remind_mime_type%TYPE default 'text/plain', + expiration_date in ml_mailing_lists.expiration_date%TYPE default sysdate, + first_reminder in ml_mailing_lists.first_reminder%TYPE default 7, + second_reminder in ml_mailing_lists.second_reminder%TYPE default 30, + comments in ml_mailing_lists.comments%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer + is + v_list_id ml_mailing_lists.list_id%TYPE; + begin + v_list_id := acs_object.new ( + object_id => new.list_id, + object_type => 'mailing_list', + creation_date => new.creation_date, + creation_user => new.creation_user, + creation_ip => new.creation_ip, + context_id => new.context_id + ); + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_list_id, name, package_id); + + insert into ml_mailing_lists + (list_id, package_id, name, locale, teaser, sender_email, + welcome_subject, welcome_body, welcome_mime_type, + confirm_subject, confirm_body, confirm_mime_type, + remind_subject, remind_body, remind_mime_type, + expiration_date, first_reminder, second_reminder, comments) + values + (v_list_id, package_id, name, locale, teaser, sender_email, + welcome_subject, welcome_body, welcome_mime_type, + confirm_subject, confirm_body, confirm_mime_type, + remind_subject, remind_body, remind_mime_type, + expiration_date, first_reminder, second_reminder, comments); + + return v_list_id; + end new; + + procedure delete ( + list_id in ml_mailing_lists.list_id%TYPE + ) is + begin + delete from ml_mailing_lists where list_id = ml_mailing_list.delete.list_id; + acs_object.delete(list_id); + end delete; + + procedure edit ( + list_id in ml_mailing_lists.list_id%TYPE default null, + name in ml_mailing_lists.name%TYPE, + locale in ml_mailing_lists.locale%TYPE, + teaser in ml_mailing_lists.teaser%TYPE default null, + sender_email in ml_mailing_lists.sender_email%TYPE default null, + confirm_subject in ml_mailing_lists.confirm_subject%TYPE default null, + confirm_body in ml_mailing_lists.confirm_body%TYPE default null, + confirm_mime_type in ml_mailing_lists.confirm_mime_type%TYPE default 'text/plain', + welcome_subject in ml_mailing_lists.welcome_subject%TYPE default null, + welcome_body in ml_mailing_lists.welcome_body%TYPE default null, + welcome_mime_type in ml_mailing_lists.welcome_mime_type%TYPE default 'text/plain', + remind_subject in ml_mailing_lists.remind_subject%TYPE default null, + remind_body in ml_mailing_lists.remind_body%TYPE default null, + remind_mime_type in ml_mailing_lists.remind_mime_type%TYPE default 'text/plain', + expiration_date in ml_mailing_lists.expiration_date%TYPE default sysdate, + first_reminder in ml_mailing_lists.first_reminder%TYPE default 7, + second_reminder in ml_mailing_lists.second_reminder%TYPE default 30, + comments in ml_mailing_lists.comments%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ) is + begin + update ml_mailing_lists + set name = edit.name, + locale = edit.locale, + teaser = edit.teaser, + sender_email = edit.sender_email, + confirm_subject = edit.confirm_subject, + confirm_body = edit.confirm_body, + confirm_mime_type = edit.confirm_mime_type, + welcome_subject = edit.welcome_subject, + welcome_body = edit.welcome_body, + welcome_mime_type = edit.welcome_mime_type, + remind_subject = edit.remind_subject, + remind_body = edit.remind_body, + remind_mime_type = edit.remind_mime_type, + expiration_date = edit.expiration_date, + first_reminder = edit.first_reminder, + second_reminder = edit.second_reminder, + comments = edit.comments + where list_id = edit.list_id; + + update acs_named_objects + set object_name = edit.name + where object_id = edit.list_id; + + update acs_objects + set modifying_user = edit.modifying_user, + modifying_ip = edit.modifying_ip + where object_id = edit.list_id; + end edit; + + function name ( + list_id in ml_mailing_lists.list_id%TYPE + ) return varchar2 + is + v_name ml_mailing_lists.name%TYPE; + begin + select name into v_name + from ml_mailing_lists + where list_id = name.list_id; + + return v_name; + end name; +end ml_mailing_list; +/ +show errors + + + + + +create or replace package ml_mail_class +as + function new ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE default null, + package_id in ml_mail_classes.package_id%TYPE default null, + name in ml_mail_classes.name%TYPE default null, + locale in ml_mail_classes.locale%TYPE default null, + sender_email in ml_mail_classes.sender_email%TYPE default null, + subject in ml_mail_classes.subject%TYPE default null, + subject_change_p in ml_mail_classes.subject_change_p%TYPE default 't', + text_header in ml_mail_classes.text_header%TYPE default null, + text_header_change_p in ml_mail_classes.text_header_change_p%TYPE default 't', + text_body in ml_mail_classes.text_body%TYPE default null, + text_body_change_p in ml_mail_classes.text_body_change_p%TYPE default 't', + text_footer in ml_mail_classes.text_footer%TYPE default null, + text_footer_change_p in ml_mail_classes.text_footer_change_p%TYPE default 't', + html_header in ml_mail_classes.html_header%TYPE default null, + html_header_change_p in ml_mail_classes.html_header_change_p%TYPE default 't', + html_body in ml_mail_classes.html_body%TYPE default null, + html_body_change_p in ml_mail_classes.html_body_change_p%TYPE default 't', + html_footer in ml_mail_classes.html_footer%TYPE default null, + html_footer_change_p in ml_mail_classes.html_footer_change_p%TYPE default 't', + mime_type in ml_mail_classes.mime_type%TYPE default 'text/plain', + comments in ml_mail_classes.comments%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer; + + procedure delete ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE + ); + + procedure edit ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE default null, + name in ml_mail_classes.name%TYPE default null, + locale in ml_mail_classes.locale%TYPE default null, + sender_email in ml_mail_classes.sender_email%TYPE default null, + subject in ml_mail_classes.subject%TYPE default null, + subject_change_p in ml_mail_classes.subject_change_p%TYPE default 't', + text_header in ml_mail_classes.text_header%TYPE default null, + text_header_change_p in ml_mail_classes.text_header_change_p%TYPE default 't', + text_body in ml_mail_classes.text_body%TYPE default null, + text_body_change_p in ml_mail_classes.text_body_change_p%TYPE default 't', + text_footer in ml_mail_classes.text_footer%TYPE default null, + text_footer_change_p in ml_mail_classes.text_footer_change_p%TYPE default 't', + html_header in ml_mail_classes.html_header%TYPE default null, + html_header_change_p in ml_mail_classes.html_header_change_p%TYPE default 't', + html_body in ml_mail_classes.html_body%TYPE default null, + html_body_change_p in ml_mail_classes.html_body_change_p%TYPE default 't', + html_footer in ml_mail_classes.html_footer%TYPE default null, + html_footer_change_p in ml_mail_classes.html_footer_change_p%TYPE default 't', + mime_type in ml_mail_classes.mime_type%TYPE default 'text/plain', + comments in ml_mail_classes.comments%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ); + + function name ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE + ) return varchar2; + +end ml_mail_class; +/ +show errors + +create or replace package body ml_mail_class +as + function new ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE default null, + package_id in ml_mail_classes.package_id%TYPE default null, + name in ml_mail_classes.name%TYPE default null, + locale in ml_mail_classes.locale%TYPE default null, + sender_email in ml_mail_classes.sender_email%TYPE default null, + subject in ml_mail_classes.subject%TYPE default null, + subject_change_p in ml_mail_classes.subject_change_p%TYPE default 't', + text_header in ml_mail_classes.text_header%TYPE default null, + text_header_change_p in ml_mail_classes.text_header_change_p%TYPE default 't', + text_body in ml_mail_classes.text_body%TYPE default null, + text_body_change_p in ml_mail_classes.text_body_change_p%TYPE default 't', + text_footer in ml_mail_classes.text_footer%TYPE default null, + text_footer_change_p in ml_mail_classes.text_footer_change_p%TYPE default 't', + html_header in ml_mail_classes.html_header%TYPE default null, + html_header_change_p in ml_mail_classes.html_header_change_p%TYPE default 't', + html_body in ml_mail_classes.html_body%TYPE default null, + html_body_change_p in ml_mail_classes.html_body_change_p%TYPE default 't', + html_footer in ml_mail_classes.html_footer%TYPE default null, + html_footer_change_p in ml_mail_classes.html_footer_change_p%TYPE default 't', + mime_type in ml_mail_classes.mime_type%TYPE default 'text/plain', + comments in ml_mail_classes.comments%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer + is + v_class_id ml_mail_classes.mail_class_id%TYPE; + begin + v_class_id := acs_object.new ( + object_id => new.mail_class_id, + object_type => 'mail_class', + creation_date => new.creation_date, + creation_user => new.creation_user, + creation_ip => new.creation_ip, + context_id => new.context_id + ); + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_class_id, name, package_id); + + insert into ml_mail_classes + (mail_class_id, package_id, name, locale, sender_email, + subject, subject_change_p, text_header, text_header_change_p, + text_body, text_body_change_p, text_footer, text_footer_change_p, + html_header, html_header_change_p, html_body, html_body_change_p, + html_footer, html_footer_change_p, mime_type, comments) + values + (v_class_id, package_id, name, locale, sender_email, + subject, subject_change_p, text_header, text_header_change_p, + text_body, text_body_change_p, text_footer, text_footer_change_p, + html_header, html_header_change_p, html_body, html_body_change_p, + html_footer, html_footer_change_p, mime_type, comments); + return v_class_id; + end new; + + procedure delete ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE + ) is + begin + for attachment in (select item_id from cr_items + where parent_id = mail_class_id) loop + content_item.delete(attachment.item_id); + end loop; + + delete from ml_mail_classes where mail_class_id = ml_mail_class.delete.mail_class_id; + acs_object.delete(mail_class_id); + end delete; + + procedure edit ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE default null, + name in ml_mail_classes.name%TYPE default null, + locale in ml_mail_classes.locale%TYPE default null, + sender_email in ml_mail_classes.sender_email%TYPE default null, + subject in ml_mail_classes.subject%TYPE default null, + subject_change_p in ml_mail_classes.subject_change_p%TYPE default 't', + text_header in ml_mail_classes.text_header%TYPE default null, + text_header_change_p in ml_mail_classes.text_header_change_p%TYPE default 't', + text_body in ml_mail_classes.text_body%TYPE default null, + text_body_change_p in ml_mail_classes.text_body_change_p%TYPE default 't', + text_footer in ml_mail_classes.text_footer%TYPE default null, + text_footer_change_p in ml_mail_classes.text_footer_change_p%TYPE default 't', + html_header in ml_mail_classes.html_header%TYPE default null, + html_header_change_p in ml_mail_classes.html_header_change_p%TYPE default 't', + html_body in ml_mail_classes.html_body%TYPE default null, + html_body_change_p in ml_mail_classes.html_body_change_p%TYPE default 't', + html_footer in ml_mail_classes.html_footer%TYPE default null, + html_footer_change_p in ml_mail_classes.html_footer_change_p%TYPE default 't', + mime_type in ml_mail_classes.mime_type%TYPE default 'text/plain', + comments in ml_mail_classes.comments%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ) is + begin + update ml_mail_classes + set name = edit.name, + locale = edit.locale, + sender_email = edit.sender_email, + subject = edit.subject, + subject_change_p = edit.subject_change_p, + text_header = edit.text_header, + text_header_change_p = edit.text_header_change_p, + text_body = edit.text_body, + text_body_change_p = edit.text_body_change_p, + text_footer = edit.text_footer, + text_footer_change_p = edit.text_footer_change_p, + html_header = edit.html_header, + html_header_change_p = edit.html_header_change_p, + html_body = edit.html_body, + html_body_change_p = edit.html_body_change_p, + html_footer = edit.html_footer, + html_footer_change_p = edit.html_footer_change_p, + mime_type = edit.mime_type, + comments = edit.comments + where mail_class_id = edit.mail_class_id; + + update acs_named_objects + set object_name = edit.name + where object_id = edit.mail_class_id; + + update acs_objects + set modifying_user = edit.modifying_user, + modifying_ip = edit.modifying_ip + where object_id = edit.mail_class_id; + end edit; + + function name ( + mail_class_id in ml_mail_classes.mail_class_id%TYPE + ) return varchar2 + is + v_name ml_mail_classes.name%TYPE; + begin + select name into v_name + from ml_mail_classes + where mail_class_id = name.mail_class_id; + + return v_name; + end name; +end ml_mail_class; +/ +show errors + + + + + +create or replace package ml_mail_job +as + function new ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE default null, + mail_class_id in ml_mail_classes.mail_class_id%TYPE, + list_id in ml_mail_jobs.list_id%TYPE default null, + selection_id in ml_mail_jobs.selection_id%TYPE default null, + package_id in ml_mail_jobs.package_id%TYPE default null, + locale in ml_mail_jobs.locale%TYPE, + sender_email in ml_mail_jobs.sender_email%TYPE default null, + track_links_p in ml_mail_jobs.track_links_p%TYPE default 'f', + subject in ml_mail_jobs.subject%TYPE default null, + text_header in ml_mail_jobs.text_header%TYPE default null, + text_body in ml_mail_jobs.text_body%TYPE default null, + text_footer in ml_mail_jobs.text_footer%TYPE default null, + html_header in ml_mail_jobs.html_header%TYPE default null, + html_body in ml_mail_jobs.html_body%TYPE default null, + html_footer in ml_mail_jobs.html_footer%TYPE default null, + template_p in ml_mail_jobs.template_p%TYPE default 'f', + mime_type in ml_mail_jobs.mime_type%TYPE default 'text/plain', + state in ml_mail_jobs.state%TYPE default 'active', + scheduled_date in ml_mail_jobs.scheduled_date%TYPE default sysdate, + bind_vars in ml_mail_jobs.bind_vars%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer; + + procedure delete ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE + ); + + procedure edit ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE, + locale in ml_mail_jobs.locale%TYPE, + sender_email in ml_mail_jobs.sender_email%TYPE default null, + track_links_p in ml_mail_jobs.track_links_p%TYPE default 'f', + subject in ml_mail_jobs.subject%TYPE default null, + text_header in ml_mail_jobs.text_header%TYPE default null, + text_body in ml_mail_jobs.text_body%TYPE default null, + text_footer in ml_mail_jobs.text_footer%TYPE default null, + html_header in ml_mail_jobs.html_header%TYPE default null, + html_body in ml_mail_jobs.html_body%TYPE default null, + html_footer in ml_mail_jobs.html_footer%TYPE default null, + template_p in ml_mail_jobs.template_p%TYPE default 'f', + mime_type in ml_mail_jobs.mime_type%TYPE default 'text/plain', + state in ml_mail_jobs.state%TYPE default 'active', + scheduled_date in ml_mail_jobs.scheduled_date%TYPE default sysdate, + bind_vars in ml_mail_jobs.bind_vars%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ); + + function name ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE + ) return varchar2; + +end ml_mail_job; +/ +show errors + +create or replace package body ml_mail_job +as + function new ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE default null, + mail_class_id in ml_mail_classes.mail_class_id%TYPE, + list_id in ml_mail_jobs.list_id%TYPE default null, + selection_id in ml_mail_jobs.selection_id%TYPE default null, + package_id in ml_mail_jobs.package_id%TYPE default null, + locale in ml_mail_jobs.locale%TYPE, + sender_email in ml_mail_jobs.sender_email%TYPE default null, + track_links_p in ml_mail_jobs.track_links_p%TYPE default 'f', + subject in ml_mail_jobs.subject%TYPE default null, + text_header in ml_mail_jobs.text_header%TYPE default null, + text_body in ml_mail_jobs.text_body%TYPE default null, + text_footer in ml_mail_jobs.text_footer%TYPE default null, + html_header in ml_mail_jobs.html_header%TYPE default null, + html_body in ml_mail_jobs.html_body%TYPE default null, + html_footer in ml_mail_jobs.html_footer%TYPE default null, + template_p in ml_mail_jobs.template_p%TYPE default 'f', + mime_type in ml_mail_jobs.mime_type%TYPE default 'text/plain', + state in ml_mail_jobs.state%TYPE default 'active', + scheduled_date in ml_mail_jobs.scheduled_date%TYPE default sysdate, + bind_vars in ml_mail_jobs.bind_vars%TYPE default null, + context_id in acs_objects.context_id%TYPE default null, + creation_user in acs_objects.creation_user%TYPE default null, + creation_date in acs_objects.creation_date%TYPE default sysdate, + creation_ip in acs_objects.creation_ip%TYPE default null + ) return integer + is + v_mail_job_id ml_mail_jobs.mail_job_id%TYPE; + v_revision_id cr_revisions.revision_id%TYPE; + begin + v_mail_job_id := acs_object.new ( + object_id => new.mail_job_id, + object_type => 'mail_job', + creation_date => new.creation_date, + creation_user => new.creation_user, + creation_ip => new.creation_ip, + context_id => new.context_id + ); + + begin + select live_revision into v_revision_id + from cr_items + where parent_id = new.mail_class_id; + exception when no_data_found then + v_revision_id := null; + end; + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_mail_job_id, subject, package_id); + + insert into ml_mail_jobs + (mail_job_id, list_id, selection_id, package_id, locale, + sender_email, track_links_p, subject, text_header, text_body, + text_footer, html_header, html_body, html_footer, + template_p, mime_type, state, scheduled_date, + css_revision_id, mail_class_id, bind_vars) + values + (v_mail_job_id, list_id, selection_id, package_id, locale, + sender_email, track_links_p, subject, text_header, text_body, + text_footer, html_header, html_body, html_footer, + template_p, mime_type, state, scheduled_date, + v_revision_id, mail_class_id, bind_vars); + + if (new.selection_id is not null) then + insert into ml_mail_job_bind_vars + (select v_mail_job_id as mail_job_id, b.name, b.description, + b.default_value as value + from us_bind_vars b + where b.selection_id = new.selection_id); + end if; + + return v_mail_job_id; + end new; + + procedure delete ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE + ) is + begin + for attachment in (select item_id from cr_items + where parent_id = mail_job_id) loop + content_item.delete(attachment.item_id); + end loop; + delete from ml_mail_jobs where mail_job_id = ml_mail_job.delete.mail_job_id; + acs_object.delete(mail_job_id); + end delete; + + procedure edit ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE, + locale in ml_mail_jobs.locale%TYPE, + sender_email in ml_mail_jobs.sender_email%TYPE default null, + track_links_p in ml_mail_jobs.track_links_p%TYPE default 'f', + subject in ml_mail_jobs.subject%TYPE default null, + text_header in ml_mail_jobs.text_header%TYPE default null, + text_body in ml_mail_jobs.text_body%TYPE default null, + text_footer in ml_mail_jobs.text_footer%TYPE default null, + html_header in ml_mail_jobs.html_header%TYPE default null, + html_body in ml_mail_jobs.html_body%TYPE default null, + html_footer in ml_mail_jobs.html_footer%TYPE default null, + template_p in ml_mail_jobs.template_p%TYPE default 'f', + mime_type in ml_mail_jobs.mime_type%TYPE default 'text/plain', + state in ml_mail_jobs.state%TYPE default 'active', + scheduled_date in ml_mail_jobs.scheduled_date%TYPE default sysdate, + bind_vars in ml_mail_jobs.bind_vars%TYPE default null, + modifying_user in acs_objects.modifying_user%TYPE default null, + modifying_ip in acs_objects.modifying_ip%TYPE default null + ) is + begin + update ml_mail_jobs + set locale = edit.locale, + sender_email = edit.sender_email, + track_links_p = edit.track_links_p, + subject = edit.subject, + text_header = edit.text_header, + text_body = edit.text_body, + text_footer = edit.text_footer, + html_header = edit.html_header, + html_body = edit.html_body, + html_footer = edit.html_footer, + template_p = edit.template_p, + mime_type = edit.mime_type, + state = edit.state, + scheduled_date = edit.scheduled_date, + bind_vars = edit.bind_vars + where mail_job_id = edit.mail_job_id + and state <> 'done'; + + update acs_named_objects + set object_name = edit.subject + where object_id = edit.mail_job_id; + + update acs_objects + set modifying_user = edit.modifying_user, + modifying_ip = edit.modifying_ip + where object_id = edit.mail_job_id; + end edit; + + function name ( + mail_job_id in ml_mail_jobs.mail_job_id%TYPE + ) return varchar2 + is + v_name ml_mail_jobs.subject%TYPE; + begin + select subject into v_name + from ml_mail_jobs + where mail_job_id = name.mail_job_id; + + return v_name; + end name; +end ml_mail_job; +/ +show errors Index: openacs-4/contrib/packages/mailing-lists/sql/oracle/upgrade.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/oracle/upgrade.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/upgrade.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,177 @@ +alter table ml_mail_classes drop constraint ml_class_subj_change_p_ck; + +alter table ml_mail_classes add ( + subject varchar2(1000), + subject_change_p char(1) default 't' constraint ml_class_subj_change_p_ck check (subject_change_p in ('t','f')), + text_header varchar2(4000), + text_header_change_p char(1) default 't' constraint ml_class_t_head_change_p_ck check (text_header_change_p in ('t','f')), + text_body varchar2(4000), + text_body_change_p char(1) default 't' constraint ml_class_t_body_change_p_ck check (text_body_change_p in ('t','f')), + text_footer varchar2(4000), + text_footer_change_p char(1) default 't' constraint ml_class_t_foot_change_p_ck check (text_footer_change_p in ('t','f')), + html_header varchar2(4000), + html_header_change_p char(1) default 't' constraint ml_class_h_head_change_p_ck check (html_header_change_p in ('t','f')), + html_body varchar2(4000), + html_body_change_p char(1) default 't' constraint ml_class_h_body_change_p_ck check (html_body_change_p in ('t','f')), + html_footer varchar2(4000), + html_footer_change_p char(1) default 't' constraint ml_class_h_foot_change_p_ck check (html_footer_change_p in ('t','f')) +); + +update ml_mail_classes +set subject = default_subject, +subject_change_p = subject_changeable_p, +text_header = default_header, +text_header_change_p = header_changeable_p, +text_body = default_body, +text_body_change_p = body_changeable_p, +text_footer = default_footer, +text_footer_change_p = footer_changeable_p +where mime_type = 'text/plain'; + +update ml_mail_classes +set subject = default_subject, +subject_change_p = subject_changeable_p, +html_header = default_header, +html_header_change_p = header_changeable_p, +html_body = default_body, +html_body_change_p = body_changeable_p, +html_footer = default_footer, +html_footer_change_p = footer_changeable_p +where mime_type = 'text/html'; + +alter table ml_mail_classes drop column default_subject; +alter table ml_mail_classes drop column default_header; +alter table ml_mail_classes drop column default_body; +alter table ml_mail_classes drop column default_footer; +alter table ml_mail_classes drop column subject_changeable_p; +alter table ml_mail_classes drop column header_changeable_p; +alter table ml_mail_classes drop column body_changeable_p; +alter table ml_mail_classes drop column footer_changeable_p; +alter table ml_mail_classes drop column x_field_p; + + +alter table ml_mail_jobs add ( + text_header varchar2(4000), + text_body clob, + text_footer varchar2(4000), + html_header varchar2(4000), + html_body clob, + html_footer varchar2(4000), + mails_bounced integer default 0 +); + +update ml_mail_jobs +set text_header = header, +text_footer = footer +where mime_type = 'text/plain'; + +update ml_mail_jobs +set html_header = header, +html_footer = footer +where mime_type = 'text/html'; + +declare + new_body clob; +begin + for t in (select mail_job_id, body, dbms_lob.getlength(body) as lob_length from ml_mail_jobs where mime_type = 'text/plain') loop + new_body:=empty_clob(); + dbms_lob.copy(new_body, t.body, t.lob_length); + update ml_mail_jobs set text_body = new_body where mail_job_id = t.mail_job_id; + end loop; +end; +/ + +update ml_mail_jobs +set text_body = body +where mime_type = 'text/plain'; + +update ml_mail_jobs +set html_body = body, text_body = null +where mime_type = 'text/html'; + +alter table ml_mail_jobs drop column header; +alter table ml_mail_jobs drop column body; +alter table ml_mail_jobs drop column footer; + +alter table ml_mailing_lists add ( + new_mime_type varchar2(30) default 'text/plain' +); +alter table ml_mail_classes add ( + new_mime_type varchar2(30) default 'text/plain' +); +alter table ml_mail_jobs add ( + new_mime_type varchar2(30) default 'text/plain' +); + +update ml_mailing_lists +set new_mime_type = mime_type; + +update ml_mail_classes +set new_mime_type = mime_type; + +update ml_mail_jobs +set new_mime_type = mime_type; + +alter table ml_mailing_lists drop column mime_type; +alter table ml_mail_classes drop column mime_type; +alter table ml_mail_jobs drop column mime_type; + +alter table ml_mailing_lists add ( + mime_type varchar2(30) default 'text/plain' +); +alter table ml_mail_classes add ( + mime_type varchar2(30) default 'text/plain' +); +alter table ml_mail_jobs add ( + mime_type varchar2(30) default 'text/plain' +); + +update ml_mailing_lists +set mime_type = new_mime_type; + +update ml_mail_classes +set mime_type = new_mime_type; + +update ml_mail_jobs +set mime_type = new_mime_type; + +alter table ml_mailing_lists drop column new_mime_type; +alter table ml_mail_classes drop column new_mime_type; +alter table ml_mail_jobs drop column new_mime_type; + +declare + v_welcome clob; +begin + for t in (select list_id, welcome_text, mime_type, dbms_lob.getlength(welcome_text) as lob_length from ml_mailing_lists where welcome_text is not null) loop + v_welcome:=empty_clob(); + dbms_lob.copy(v_welcome, t.welcome_text, t.lob_length); + update ml_mailing_lists set welcome_body = v_welcome, + welcome_mime_type = t.mime_type where list_id = t.list_id; + end loop; +end; +/ + +alter table ml_mailing_lists add ( + remind_subject varchar2(1000), + remind_body clob, + remind_mime_type varchar2(30) default 'text/plain' +); + +alter table ml_mailing_list_user_map add ( + reminder_count integer default 0 +); + +create table ml_user_email_log ( + user_id integer primary key + constraint ml_user_email_log_id_fk + references users, + last_mail_date date default null +); + +create index ml_user_email_log_date_ix on ml_user_email_log(last_mail_date); + +insert into ml_user_email_log +(select m.user_id, max(l.send_date) as last_mail_date +from ml_email_log l, ml_mailing_list_user_map m +where m.user_id = l.user_id(+) +group by m.user_id); Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-create.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,294 @@ +-- $Id: mailing-lists-create.sql,v 1.1 2003/10/01 05:01:53 maltes Exp $ + + +-- use package vars for bounce manager (#of bounced emails to mark user +-- as bouncing, #of days of last mail sent unbounced so that bounce +-- history of user is deleted) and upper limit of attachment size + + +-- create the object types + + select acs_object_type__create_type ( + 'mailing_list', + 'Mailing List', + 'Mailing Lists', + 'acs_object', + 'ml_mailing_lists', + 'list_id', + null, + 'f', + null, + 'ml_mailing_list__name' + ); + + select acs_object_type__create_type ( + 'mail_class', + 'Mailing Class', + 'Mailing Classes', + 'acs_object', + 'ml_mail_classes', + 'mail_class_id', + null, + 'f', + null, + 'ml_mail_class__name' + ); + + select acs_object_type__create_type ( + 'mail_job', + 'Mailing Job', + 'Mailing Jobs', + 'acs_object', + 'ml_mail_jobs', + 'mail_job_id', + null, + 'f', + null, + 'ml_mail_job__name' + ); + + +-- create the privileges + + select acs_privilege__create_privilege('mailing_list_admin','Mailing Lists Administrator', null); + + select acs_privilege__add_child('admin','mailing_list_admin'); + + +create table ml_mailing_lists ( + list_id integer + constraint ml_mailing_lists_pk + primary key, + package_id integer + constraint ml_mailing_lists_pck_id_fk + references apm_packages, + name text + constraint ml_mailing_lists_name_nn + not null, + locale varchar(5) + constraint ml_mailing_lists_locale_nn + not null + constraint ml_mail_lists_locale_fk + references ad_locales, + teaser text, + public_p boolean, + sender_email text, + confirm_subject text, + confirm_body text, + confirm_mime_type varchar(30) default 'text/plain', + welcome_subject text, + welcome_body text, + welcome_mime_type varchar(30) default 'text/plain', + remind_subject text, + remind_body text, + remind_mime_type varchar(30) default 'text/plain', + expiration_date timestamptz, + -- amount of days after sending registration email + first_reminder integer default 7, + -- 0 if no second reminder + second_reminder integer default 30, + comments text +); + +-- target, distribution and campaign: use categories (will be posted) + +create table ml_mailing_list_user_map ( + list_id integer + constraint ml_ml_user_map_list_fk + references ml_mailing_lists + on delete cascade, + user_id integer + constraint ml_ml_user_map_user_fk + references users + on delete cascade, + subscription_date timestamptz default current_timestamp, + unsubscription_date timestamptz, + subscribed_p boolean, + confirmed_p boolean, + reminder_count integer default 0, + constraint ml_mailing_list_user_map_pk + primary key (list_id, user_id) +); + +-- to speed up queries to get all lists for a user +create unique index ml_mailing_list_users_ix on ml_mailing_list_user_map (user_id, list_id); +create index ml_mail_list_users_subsc_p_ix on ml_mailing_list_user_map(subscribed_p); + +create table ml_mail_classes ( + mail_class_id integer + constraint ml_mail_classes_pk + primary key, + package_id integer + constraint ml_mail_classes_pck_id_fk + references apm_packages, + name text + constraint ml_mail_classes_name_nn + not null, + locale varchar(5) + constraint ml_mail_classes_locale_nn + not null + constraint ml_mail_classes_locale_fk + references ad_locales, + public_p boolean, + sender_email varchar(100), + subject text, + subject_change_p boolean, + text_header text, + text_header_change_p boolean, + text_body text, + text_body_change_p boolean, + text_footer text, + text_footer_change_p boolean, + html_header text, + html_header_change_p boolean, + html_body text, + html_body_change_p boolean, + html_footer text, + html_footer_change_p boolean, + mime_type varchar(30) default 'text/plain', + comments text +); + +create table ml_mail_jobs ( + mail_job_id integer + constraint ml_mail_jobs_pk + primary key, + mail_class_id integer + constraint ml_mail_jobs_mail_class_id_fk + references acs_objects + on delete set null, + list_id integer + constraint ml_mail_jobs_list_id_fk + references acs_objects + on delete set null, + selection_id integer + constraint ml_mail_jobs_sel_id_fk + references acs_objects + on delete set null, + package_id integer + constraint ml_mail_jobs_package_id_fk + references apm_packages, + locale varchar(5) + constraint ml_mail_jobs_locale_nn + not null + constraint ml_mail_jobs_locale_fk + references ad_locales, + sender_email varchar(100), + track_links_p boolean, + subject text, + text_header text, + text_body text, + text_footer text, + html_header text, + html_body text, + html_footer text, + template_p boolean, + mime_type varchar(30) default 'text/plain', + css_revision_id integer + constraint ml_mail_jobs_css_rev_id_fk + references cr_revisions on delete set null, + state varchar(10), + scheduled_date timestamptz default current_timestamp, + execution_date timestamptz, + sql_query text, + bind_vars text, + mails_sent integer default 0, + mails_bounced integer default 0 +); + +create index ml_jobs_scheduled_date_ix on ml_mail_jobs(scheduled_date); +create index ml_jobs_execution_date_ix on ml_mail_jobs(execution_date); + + +create table ml_mail_job_bind_vars ( + mail_job_id integer + constraint ml_m_job_b_vars_job_id_fk + references ml_mail_jobs + on delete cascade, + name varchar(30), + description text, + value text, + constraint ml_mail_job_bind_vars_pk + primary key (mail_job_id, name) +); + +-- make sure that this table doesn't fill up too much +-- i.e. delete all data older than 7 days + +create table ml_email_log ( + user_id integer + constraint ml_email_log_user_id_fk + references users, + mail_job_id integer + constraint ml_email_log_mail_job_id_fk + references ml_mail_jobs, + send_date timestamptz default current_timestamp, + constraint ml_email_log_pk + primary key (user_id, mail_job_id) +); + +create index ml_email_log_date_ix on ml_email_log(send_date); + +create table ml_user_email_log ( + user_id integer primary key + constraint ml_user_email_log_id_fk + references users, + last_mail_date timestamptz default null +); + +create index ml_user_email_log_date_ix on ml_user_email_log(last_mail_date); + +create table ml_bounce_log ( + mail_job_id integer + constraint ml_bounce_log_mail_job_id_fk + references ml_mail_jobs + on delete cascade, + user_id integer + constraint ml_bounce_log_user_id_fk + references users + on delete cascade, + sending_time timestamptz, + bouncing_time timestamptz default current_timestamp, + constraint ml_bounce_log_pk + primary key (mail_job_id, user_id) +); + +create index ml_bounce_log_bounce_time_ix on ml_bounce_log(bouncing_time); + +create table ml_category_trees_visible ( + tree_id integer + constraint ml_cat_trees_vis_tree_id_fk + references acs_objects + on delete cascade, + package_id integer + constraint ml_cat_trees_vis_pck_id_fk + references apm_packages, + constraint ml_cat_trees_vis_pk + primary key (package_id, tree_id) +); + +create table ml_country_category_tree ( + tree_id integer + constraint ml_country_category_tree_id_fk + references acs_objects + on delete cascade, + package_id integer + constraint ml_country_cat_tree_pck_id_fk + references apm_packages, + constraint ml_country_category_tree_pk + primary key (package_id, tree_id) +); + +create table ml_country_codes ( + country_code varchar(3) + constraint ml_country_codes_pk + primary key, + category_id integer + constraint ml_country_codes_cat_id_fk + references acs_objects + on delete cascade +); + + +\i mailing-lists-package-create.sql +\i mailing-lists-init.sql Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-drop.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-drop.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,54 @@ +\i mailing-lists-package-drop.sql + +drop table ml_country_codes; +drop table ml_country_category_tree; +drop table ml_category_trees_visible; +drop table ml_bounce_log; +drop table ml_user_email_log; +drop table ml_email_log; +drop table ml_mail_job_bind_vars; +drop table ml_mail_jobs; +drop table ml_mail_classes; +drop table ml_mailing_list_user_map; +drop table ml_mailing_lists; + +delete from acs_objects where object_type='mailing_list'; +delete from acs_objects where object_type='mail_class'; +delete from acs_objects where object_type='mail_job'; + +delete from acs_permissions +where privilege in ('mailing_list_admin'); + +delete from acs_privilege_hierarchy +where privilege in ('mailing_list_admin'); + +delete from acs_privilege_hierarchy +where child_privilege in ('mailing_list_admin'); + +delete from acs_privileges +where privilege in ('mailing_list_admin'); + + +select acs_object_type__drop_type('mailing_list','f'); +select acs_object_type__drop_type('mail_class','f'); +select acs_object_type__drop_type('mail_job','f'); + +select acs_sc_binding__delete( + 'AcsObject', + 'mailing_list_idhandler' +); +select acs_sc_impl__delete('AcsObject', 'mailing_list_idhandler'); + + +select acs_sc_binding__delete( + 'AcsObject', + 'mail_class_idhandler' +); +select acs_sc_impl__delete('AcsObject', 'mail_class_idhandler'); + + +select acs_sc_binding__delete( + 'AcsObject', + 'mail_job_idhandler' +); +select acs_sc_impl__delete('AcsObject', 'mail_job_idhandler'); Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-init.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-init.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-init.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,54 @@ + select acs_sc_impl__new ( + 'AcsObject', + 'mailing_list_idhandler', + 'mailing-lists' + ); + select acs_sc_impl_alias__new ( + 'AcsObject', + 'mailing_list_idhandler', + 'PageUrl', + 'ml_get_mailing_list_pageurl', + 'TCL' + ); + select acs_sc_binding__new ( + 'AcsObject', + 'mailing_list_idhandler' + ); + + + + select acs_sc_impl__new ( + 'AcsObject', + 'mail_class_idhandler', + 'mailing-lists' + ); + select acs_sc_impl_alias__new ( + 'AcsObject', + 'mail_class_idhandler', + 'PageUrl', + 'ml_get_mail_class_pageurl', + 'TCL' + ); + select acs_sc_binding__new ( + 'AcsObject', + 'mail_class_idhandler' + ); + + + + select acs_sc_impl__new ( + 'AcsObject', + 'mail_job_idhandler', + 'mailing-lists' + ); + select acs_sc_impl_alias__new ( + 'AcsObject', + 'mail_job_idhandler', + 'PageUrl', + 'ml_get_mail_job_pageurl', + 'TCL' + ); + select acs_sc_binding__new ( + 'AcsObject', + 'mail_job_idhandler' + ); Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-create.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-create.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,494 @@ +-- API for Mailing lists + +create or replace function ml_mailing_list__new (integer,integer,text,varchar,text,text,text,text,varchar,text,text,varchar,text,text,varchar,timestamptz,integer,integer,text,integer,integer,timestamptz,varchar) +returns integer as ' +declare + new__list_id alias for $1; -- default null + new__package_id alias for $2; -- default null + new__name alias for $3; + new__locale alias for $4; + new__teaser alias for $5; + new__sender_email alias for $6; -- default null + new__confirm_subject alias for $7; -- default null + new__confirm_body alias for $8; -- default null + new__confirm_mime_type alias for $9; -- default ''text/plain'' + new__welcome_subject alias for $10; -- default null + new__welcome_body alias for $11; -- default null + new__welcome_mime_type alias for $12; -- default ''text/plain'' + new__remind_subject alias for $13; -- default null + new__remind_body alias for $14; -- default null + new__remind_mime_type alias for $15; -- default ''text/plain'' + new__expiration_date alias for $16; -- default sysdate + new__first_reminder alias for $17; -- default 7 + new__second_reminder alias for $18; -- default 30 + new__comments alias for $19; -- default null + new__context_id alias for $20; -- default null + new__creation_user alias for $21; -- default null + new__creation_date alias for $22; -- default sysdate + new__creation_ip alias for $23; -- default null + + v_list_id ml_mailing_lists.list_id%TYPE; +begin + + v_list_id := acs_object__new ( + new__list_id, + ''mailing_list'', + new__creation_date, + new__creation_user, + new__creation_ip, + new__context_id + ); + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_list_id, new__name, new__package_id); + + insert into ml_mailing_lists + (list_id, package_id, name, locale, teaser, sender_email, + welcome_subject, welcome_body, welcome_mime_type, + confirm_subject, confirm_body, confirm_mime_type, + remind_subject, remind_body, remind_mime_type, + expiration_date, first_reminder, second_reminder, comments) + values + (v_list_id, new__package_id, new__name, new__locale, new__teaser, new__sender_email, + new__welcome_subject, new__welcome_body, new__welcome_mime_type, + new__confirm_subject, new__confirm_body, new__confirm_mime_type, + new__remind_subject, new__remind_body, new__remind_mime_type, + new__expiration_date, new__first_reminder, new__second_reminder, new__comments); + + return v_list_id; + +end;' language 'plpgsql'; + + + + +create or replace function ml_mailing_list__delete (integer) +returns integer as ' +declare + delete__list_id alias for $1; +begin + delete from ml_mailing_lists where list_id = delete__list_id; + perform acs_object__delete(delete__list_id); + + return 0; +end;' language 'plpgsql'; + +create or replace function ml_mailing_list__edit (integer,text,varchar,text,text,text,text,varchar,text,text,varchar,text,text,varchar,timestamptz,integer,integer,text,integer,varchar) +returns integer as ' +declare + edit__list_id alias for $1; -- default null + edit__name alias for $2; + edit__locale alias for $3; + edit__teaser alias for $4; + edit__sender_email alias for $5; -- default null + edit__confirm_subject alias for $6; -- default null + edit__confirm_body alias for $7; -- default null + edit__confirm_mime_type alias for $8; -- default ''text/plain'' + edit__welcome_subject alias for $9; -- default null + edit__welcome_body alias for $10; -- default null, + edit__welcome_mime_type alias for $11; -- default ''text/plain'' + edit__remind_subject alias for $12; -- default null + edit__remind_body alias for $13; -- default null, + edit__remind_mime_type alias for $14; -- default ''text/plain'' + edit__expiration_date alias for $15; -- default sysdate + edit__first_reminder alias for $16; -- default 7 + edit__second_reminder alias for $17; -- default 30 + edit__comments alias for $18; -- default null + edit__modifying_user alias for $19; -- default null + edit__modifying_ip alias for $20; -- default null +begin + update ml_mailing_lists + set name = edit__name, + locale = edit__locale, + teaser = edit__teaser, + sender_email = edit__sender_email, + confirm_subject = edit__confirm_subject, + confirm_body = edit__confirm_body, + confirm_mime_type = edit__confirm_mime_type, + welcome_subject = edit__welcome_subject, + welcome_body = edit__welcome_body, + welcome_mime_type = edit__welcome_mime_type, + remind_subject = edit__remind_subject, + remind_body = edit__remind_body, + remind_mime_type = edit__remind_mime_type, + expiration_date = edit__expiration_date, + first_reminder = edit__first_reminder, + second_reminder = edit__second_reminder, + comments = edit__comments + where list_id = edit__list_id; + + update acs_named_objects + set object_name = edit__name + where object_id = edit__list_id; + + update acs_objects + set modifying_user = edit__modifying_user, + modifying_ip = edit__modifying_ip + where object_id = edit__list_id; + + return 0; + +end;' language 'plpgsql'; + + +create or replace function ml_mailing_list__name (integer) +returns varchar as ' +declare + name__list_id alias for $1; + v_name ml_mailing_lists.name%TYPE; +begin + select into v_name name + from ml_mailing_lists + where list_id = name__list_id; + + return v_name; +end;' language 'plpgsql'; + + +-- API for Mailing Classes + + +create or replace function ml_mail_class__new (integer,integer,text,varchar,varchar,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,varchar,text,integer,integer,timestamptz,varchar) +returns integer as ' +declare + new__mail_class_id alias for $1; -- default null + new__package_id alias for $2; -- default null, + new__name alias for $3; -- default null, + new__locale alias for $4; -- default null, + new__sender_email alias for $5; -- default null, + new__subject alias for $6; -- default null, + new__subject_change_p alias for $7; -- default ''t'', + new__text_header alias for $8; -- default null, + new__text_header_change_p alias for $9; -- default ''t'', + new__text_body alias for $10; -- default null, + new__text_body_change_p alias for $11; -- default ''t'', + new__text_footer alias for $12; -- default null, + new__text_footer_change_p alias for $13; -- default ''t'', + new__html_header alias for $14; -- default null, + new__html_header_change_p alias for $15; -- default ''t'', + new__html_body alias for $16; -- default null, + new__html_body_change_p alias for $17; -- default ''t'', + new__html_footer alias for $18; -- default null, + new__html_footer_change_p alias for $19; -- default ''t'', + new__mime_type alias for $20; -- default ''text/plain'', + new__comments alias for $21; -- default null, + new__context_id alias for $22; -- default null, + new__creation_user alias for $23; -- default null, + new__creation_date alias for $24; -- default sysdate, + new__creation_ip alias for $25; -- default null + + v_class_id ml_mail_classes.mail_class_id%TYPE; + +begin + v_class_id := acs_object__new ( + new__mail_class_id, + ''mail_class'', + new__creation_date, + new__creation_user, + new__creation_ip, + new__context_id + ); + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_class_id, new__name, new__package_id); + + + insert into ml_mail_classes + (mail_class_id, package_id, name, locale, sender_email, + subject, subject_change_p, text_header, text_header_change_p, + text_body, text_body_change_p, text_footer, text_footer_change_p, + html_header, html_header_change_p, html_body, html_body_change_p, + html_footer, html_footer_change_p, mime_type, comments) + values + (v_class_id, new__package_id, new__name, new__locale, new__sender_email, + new__subject, new__subject_change_p, new__text_header, new__text_header_change_p, + new__text_body, new__text_body_change_p, new__text_footer, new__text_footer_change_p, + new__html_header, new__html_header_change_p, new__html_body, new__html_body_change_p, + new__html_footer, new__html_footer_change_p, new__mime_type, new__comments); + + return v_class_id; + +end;' language 'plpgsql'; + + +create or replace function ml_mail_class__delete (integer) +returns integer as ' +declare + delete__mail_class_id alias for $1; + v_attachment cr_items%ROWTYPE; + v_mail_job acs_objects%ROWTYPE; +begin + for v_attachment in select item_id from cr_items + where parent_id = delete__mail_class_id + loop + perform content_item__delete(v_attachment.item_id); + end loop; + + update ml_mail_jobs set mail_class_id = NULL where mail_class_id = delete__mail_class_id; + + for v_mail_job in select object_id from acs_objects + where context_id = delete__mail_class_id and + object_type = ''mail_job'' + loop + update acs_objects set context_id = ( + select package_id from ml_mail_jobs + where mail_job_id = v_mail_job.object_id) + where object_id = v_mail_job.object_id; + end loop; + + delete from ml_mail_classes where mail_class_id = delete__mail_class_id; + perform acs_object__delete(delete__mail_class_id); + + return 0; + +end;' language 'plpgsql'; + + + +create or replace function ml_mail_class__edit (integer,text,varchar,varchar,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,varchar,text,integer,varchar) +returns integer as ' +declare + edit__mail_class_id alias for $1; -- default null + edit__name alias for $2; -- default null, + edit__locale alias for $3; -- default null, + edit__sender_email alias for $4; -- default null, + edit__subject alias for $5; -- default null, + edit__subject_change_p alias for $6; -- default ''t'', + edit__text_header alias for $7; -- default null, + edit__text_header_change_p alias for $8; -- default ''t'', + edit__text_body alias for $9; -- default null, + edit__text_body_change_p alias for $10; -- default ''t'', + edit__text_footer alias for $11; -- default null, + edit__text_footer_change_p alias for $12; -- default ''t'', + edit__html_header alias for $13; -- default null, + edit__html_header_change_p alias for $14; -- default ''t'', + edit__html_body alias for $15; -- default null, + edit__html_body_change_p alias for $16; -- default ''t'', + edit__html_footer alias for $17; -- default null, + edit__html_footer_change_p alias for $18; -- default ''t'', + edit__mime_type alias for $19; -- default ''text/plain'', + edit__comments alias for $20; -- default null, + edit__modifying_user alias for $21; -- default null, + edit__modifying_ip alias for $22; -- default null +begin + update ml_mail_classes + set name = edit__name, + locale = edit__locale, + sender_email = edit__sender_email, + subject = edit__subject, + subject_change_p = edit__subject_change_p, + text_header = edit__text_header, + text_header_change_p = edit__text_header_change_p, + text_body = edit__text_body, + text_body_change_p = edit__text_body_change_p, + text_footer = edit__text_footer, + text_footer_change_p = edit__text_footer_change_p, + html_header = edit__html_header, + html_header_change_p = edit__html_header_change_p, + html_body = edit__html_body, + html_body_change_p = edit__html_body_change_p, + html_footer = edit__html_footer, + html_footer_change_p = edit__html_footer_change_p, + mime_type = edit__mime_type, + comments = edit__comments + where mail_class_id = edit__mail_class_id; + + update acs_named_objects + set object_name = edit__name + where object_id = edit__mail_class_id; + + update acs_objects + set modifying_user = edit__modifying_user, + modifying_ip = edit__modifying_ip + where object_id = edit__mail_class_id; + + return 0; + +end;' language 'plpgsql'; + + +create or replace function ml_mail_class__name (integer) +returns varchar as ' +declare + name__mail_class_id alias for $1; + v_name ml_mail_classes.name%TYPE; +begin + select into v_name name + from ml_mail_classes + where mail_class_id = name__mail_class_id; + + return v_name; + +end;' language 'plpgsql'; + + + +-- API for Mailing List Jobs + +create or replace function ml_mail_job__new (integer,integer,integer,integer,integer,varchar,varchar,boolean,text,text,text,text,text,text,text,boolean,varchar,varchar,timestamptz,text,integer,integer,timestamptz,varchar) +returns integer as ' +declare + new__mail_job_id alias for $1; -- default null + new__mail_class_id alias for $2; + new__list_id alias for $3; -- default null + new__selection_id alias for $4; -- default null + new__package_id alias for $5; -- default null + new__locale alias for $6; + new__sender_email alias for $7; -- default null + new__track_links_p alias for $8; -- default ''f'' + new__subject alias for $9; -- default null + new__text_header alias for $10; -- default null + new__text_body alias for $11; -- default null + new__text_footer alias for $12; -- default null + new__html_header alias for $13; -- default null + new__html_body alias for $14; -- default null + new__html_footer alias for $15; -- default null + new__template_p alias for $16; -- default ''f'' + new__mime_type alias for $17; -- default ''text/plain'' + new__state alias for $18; -- default ''active'' + new__scheduled_date alias for $19; -- default sysdate + new__bind_vars alias for $20; -- default null + new__context_id alias for $21; -- default null + new__creation_user alias for $22; -- default null + new__creation_date alias for $23; -- default sysdate + new__creation_ip alias for $24; -- default null + + v_mail_job_id ml_mail_jobs.mail_job_id%TYPE; + v_revision_id cr_revisions.revision_id%TYPE; +begin + v_mail_job_id := acs_object__new ( + new__mail_job_id, + ''mail_job'', + new__creation_date, + new__creation_user, + new__creation_ip, + new__context_id + ); + + select into v_revision_id live_revision + from cr_items + where parent_id = new__mail_class_id; + IF NOT FOUND THEN + v_revision_id := null; + END IF; + + insert into acs_named_objects (object_id, object_name, package_id) + values (v_mail_job_id, new__subject, new__package_id); + + insert into ml_mail_jobs + (mail_job_id, list_id, selection_id, package_id, locale, + sender_email, track_links_p, subject, text_header, text_body, + text_footer, html_header, html_body, html_footer, + template_p, mime_type, state, scheduled_date, + css_revision_id, mail_class_id, bind_vars) + values + (v_mail_job_id, new__list_id, new__selection_id, new__package_id, new__locale, + new__sender_email, new__track_links_p, new__subject, new__text_header, new__text_body, + new__text_footer, new__html_header, new__html_body, new__html_footer, + new__template_p, new__mime_type, new__state, new__scheduled_date, + v_revision_id, new__mail_class_id, new__bind_vars); + + if (new__selection_id is not null) then + insert into ml_mail_job_bind_vars + (select v_mail_job_id as mail_job_id, b.name, b.description, + b.default_value as value + from us_bind_vars b + where b.selection_id = new__selection_id); + end if; + + return v_mail_job_id; + +end;' language 'plpgsql'; + + + + +create or replace function ml_mail_job__delete (integer) +returns integer as ' +declare + delete__mail_job_id alias for $1; + v_attachment cr_items%ROWTYPE; +begin + for v_attachment in select item_id from cr_items + where parent_id = delete__mail_job_id + loop + perform content_item__delete(item_id); + end loop; + + delete from ml_mail_jobs where mail_job_id = delete__mail_job_id; + perform acs_object__delete(delete__mail_job_id); + + return 0; + +end;' language 'plpgsql'; + + + +create or replace function ml_mail_job__edit (integer,varchar,varchar,boolean,text,text,text,text,text,text,text,boolean,varchar,varchar,timestamptz,text,integer,varchar) +returns integer as ' +declare + edit__mail_job_id alias for $1; + edit__locale alias for $2; + edit__sender_email alias for $3; -- default null + edit__track_links_p alias for $4; -- default ''f'' + edit__subject alias for $5; -- default null + edit__text_header alias for $6; -- default null + edit__text_body alias for $7; -- default null + edit__text_footer alias for $8; -- default null + edit__html_header alias for $9; -- default null + edit__html_body alias for $10; -- default null + edit__html_footer alias for $11; -- default null + edit__template_p alias for $12; -- default ''f'' + edit__mime_type alias for $13; -- default ''text/plain'' + edit__state alias for $14; -- default ''active'' + edit__scheduled_date alias for $15; -- default sysdate + edit__bind_vars alias for $16; -- default null + edit__modifying_user alias for $17; -- default null + edit__modifying_ip alias for $18; -- default null +begin + + update ml_mail_jobs + set locale = edit__locale, + sender_email = edit__sender_email, + track_links_p = edit__track_links_p, + subject = edit__subject, + text_header = edit__text_header, + text_body = edit__text_body, + text_footer = edit__text_footer, + html_header = edit__html_header, + html_body = edit__html_body, + html_footer = edit__html_footer, + template_p = edit__template_p, + mime_type = edit__mime_type, + state = edit__state, + scheduled_date = edit__scheduled_date, + bind_vars = edit__bind_vars + where mail_job_id = edit__mail_job_id + and state <> ''done''; + + update acs_named_objects + set object_name = edit__subject + where object_id = edit__mail_job_id; + + update acs_objects + set modifying_user = edit__modifying_user, + modifying_ip = edit__modifying_ip + where object_id = edit__mail_job_id; + + return 0; + +end;' language 'plpgsql'; + +create or replace function ml_mail_job__name (integer) +returns varchar as ' +declare + name__mail_job_id alias for $1; + v_name ml_mail_jobs.subject%TYPE; +begin + select into v_name subject + from ml_mail_jobs + where mail_job_id = name__mail_job_id; + + return v_name; +end;' language 'plpgsql'; + Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-drop.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-drop.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,25 @@ +drop function ml_mailing_list__new(integer,integer,text,varchar,text,text,text,text,varchar,text,text,varchar,timestamptz,integer,integer,text,integer,integer,timestamptz,varchar); + +drop function ml_mailing_list__delete (integer); + +drop function ml_mailing_list__edit (integer,text,varchar,text,text,text,text,varchar,text,text,varchar,timestamptz,integer,integer,text,integer,varchar); + +drop function ml_mailing_list__name (integer); + + +drop function ml_mail_class__new (integer,integer,text,varchar,varchar,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,varchar,text,integer,integer,timestamptz,varchar); + +drop function ml_mail_class__delete (integer); + +drop function ml_mail_class__edit (integer,text,varchar,varchar,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,text,boolean,varchar,text,integer,varchar); + +drop function ml_mail_class__name (integer); + + +drop function ml_mail_job__new (integer,integer,integer,integer,integer,varchar,varchar,boolean,text,text,text,text,text,text,text,boolean,varchar,varchar,timestamptz,text,integer,integer,timestamptz,varchar); + +drop function ml_mail_job__delete (integer); + +drop function ml_mail_job__edit (integer,varchar,varchar,boolean,text,text,text,text,text,text,text,boolean,varchar,varchar,timestamptz,text,integer,varchar); + +drop function ml_mail_job__name (integer); \ No newline at end of file Index: openacs-4/contrib/packages/mailing-lists/sql/postgresql/upgrade.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/sql/postgresql/upgrade.sql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/upgrade.sql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,23 @@ +alter table ml_mailing_lists add remind_subject text; +alter table ml_mailing_lists add remind_body text; +alter table ml_mailing_lists add remind_mime_type varchar(30); +alter table ml_mailing_lists alter column remind_mime_type set default 'text/plain'; + +alter table ml_mailing_list_user_map add reminder_count integer; +alter table ml_mailing_list_user_map alter column reminder_count set default 0; + +create table ml_user_email_log ( + user_id integer primary key + constraint ml_user_email_log_id_fk + references users, + last_mail_date timestamptz default null +); + +create index ml_user_email_log_date_ix on ml_user_email_log(last_mail_date); + +insert into ml_user_email_log +(select m.user_id, max(l.send_date) as last_mail_date +from ml_mailing_list_user_map m +left outer join ml_email_log l +on (m.user_id = l.user_id) +group by m.user_id); Index: openacs-4/contrib/packages/mailing-lists/tcl/email-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/email-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs-oracle.xql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,87 @@ + + + + oracle8.1.6 + + + + + select mail_job_id + from ml_mail_jobs + where state = 'active' + and scheduled_date <= sysdate + + + + + + + + + update ml_mail_jobs + set state = 'started', + execution_date = sysdate + where mail_job_id = :mail_job_id + + + + + + + + + select r.mime_type, r.title, r.filename + from cr_revisions r + where r.revision_id = :css_revision_id + union + select r.mime_type, r.title, r.filename + from cr_items i, cr_revisions r + where r.item_id = i.item_id + and i.parent_id = :mail_job_id + + + + + + + + + update ml_user_email_log + set last_mail_date = sysdate + where user_id = :user_id + + + + + + + + + update ml_mail_jobs + set state = 'finished', + mails_sent = :mail_count, + track_links_p = (select case when count(*) = 0 then 'f' else 't' end + from mail_link_mail_map m + where mail_id = :mail_job_id) + where mail_job_id = :mail_job_id + + + + + + + + + insert into ml_bounce_log (mail_job_id, user_id, sending_time, + bouncing_time) + (select mail_job_id, user_id, send_date as sending_time, + sysdate as bouncing_time + from ml_email_log + where mail_job_id = :job_id + and user_id = :user_id) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/email-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/email-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs-postgresql.xql 1 Oct 2003 05:01:53 -0000 1.1 @@ -0,0 +1,85 @@ + + + + postgresql7.1 + + + + + select mail_job_id + from ml_mail_jobs + where state = 'active' + and scheduled_date <= current_timestamp + + + + + + + + + update ml_mail_jobs + set state = 'started', + execution_date = current_timestamp + where mail_job_id = :mail_job_id + + + + + + + + + select r.mime_type, r.title, r.content as filename + from cr_revisions r + where r.revision_id = :css_revision_id + union + select r.mime_type, r.title, r.content as filename + from cr_items i, cr_revisions r + where r.item_id = i.item_id + and i.parent_id = :mail_job_id + + + + + + + + update ml_user_email_log + set last_mail_date = current_timestamp + where user_id = :user_id + + + + + + + + update ml_mail_jobs + set state = 'finished', + mails_sent = :mail_count, + track_links_p = (select case when count(*) = 0 then FALSE else TRUE end + from mail_link_mail_map m + where mail_id = :mail_job_id) + where mail_job_id = :mail_job_id + + + + + + + + + insert into ml_bounce_log (mail_job_id, user_id, sending_time, + bouncing_time) + (select mail_job_id, user_id, send_date as sending_time, + current_timestamp as bouncing_time + from ml_email_log + where mail_job_id = :job_id + and user_id = :user_id) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/email-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/email-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,441 @@ +namespace eval mail_job { + + ad_proc -public send { + -mail_job_id:required + } { + Send email + } { + set boundary_string "-+-+-someboundarystring-+-+-" + set alternative_string "-+-+-somealternativestring-+-+-" + set system_url [ad_url] + regsub -all {http://} $system_url {} system_url + + # get the mail job data + if {![db_0or1row get_data {}]} { + return + } + + # mark mail job as started + db_dml start_mail_job {} + + # glue body and footer together + if {$mail_mime_type != "text/html"} { + set text_body "$text_header\n$text_body\n$text_footer" + } + if {$mail_mime_type != "text/plain"} { + set html_body "$html_header\n$html_body\n$html_footer" + } + + # get endofline characters right + set text_body [string map {\r ""} $text_body] + set html_body [string map {\r ""} $html_body] + + # substitute links in mail if link tracking enabled + if {$track_links_p == "t"} { + if {$mail_mime_type != "text/html"} { + set text_body [mail_job::create_links -text $text_body -mime_type text/plain -mail_job_id $mail_job_id] + } + if {$mail_mime_type != "text/plain"} { + set html_body [mail_job::create_links -text $html_body -mime_type text/html -mail_job_id $mail_job_id] + } + set template_p t + } + + set attachments "" + # encode all attachments in base64 + db_foreach get_attachments {} { + set mail_filename "\"[ad_quotehtml $title]\"" + + # encode current attachment in base64 and wrap it in + # appropriate email-multipart form + set content [mail_job::base64_encode -filename "[cr_fs_path]$filename"] + + append attachments "\n--$boundary_string +Content-Type: $mime_type; name=$mail_filename +Content-Transfer-Encoding: base64 +Content-Disposition: attachment; filename=$mail_filename + +$content\n" + } + + set header [ns_set new] + if {![empty_string_p $attachments]} { + # set correct header and correct begin/end of multipart-mail + + # finish multipart email + append attachments "\n--$boundary_string\--" + + # begin multipart/mixed email. + ns_set put $header "Content-Type" "Multipart/Mixed; boundary=\"$boundary_string\"" + + set begin_body "This is a multi-part message in MIME format.\n\n--$boundary_string\n" + switch $mail_mime_type { + "text/plain" { + # quoted-printable encode plaintext mails + append begin_body "Content-Type: text/plain\nContent-Disposition: inline\n\n" +###### +# append begin_body "Content-Type: text/plain\nContent-Transfer-Encoding: quoted-printable\nContent-Disposition: inline\n\n" +###### + } + "text/html" { + append begin_body "Content-Type: text/html; charset=$mime_charset\nContent-Disposition: inline\n\n" + } + "multipart/alternative" { + # begin multipart/alternative part inside the multipart/mixed mail + append begin_body "Content-Type: multipart/alternative; boundary=\"$alternative_string\"\n\n--$alternative_string\nContent-Type: text/plain" +###### +# append begin_body "Content-Type: multipart/alternative; boundary=\"$alternative_string\"\n\n--$alternative_string\nContent-Type: text/plain\nContent-Transfer-Encoding: quoted-printable" +###### + set alternative_body "\n--$alternative_string\nContent-Type: text/html; charset=$mime_charset" + set attachments "\n--$alternative_string\--\n$attachments" + } + } + + } else { + # no attachments, so set correct header + switch $mail_mime_type { + "text/plain" { + # quoted-printable encode plaintext mails + ns_set put $header "Content-Type" text/plain +###### +# ns_set put $header "Content-Transfer-Encoding" quoted-printable +###### + set begin_body "" + } + "text/html" { + ns_set put $header "Content-Type" "text/html; charset=$mime_charset" + set begin_body "" + } + "multipart/alternative" { + # begin multipart/alternative email + ns_set put $header "Content-Type" "Multipart/Alternative; boundary=\"$boundary_string\"" + # quoted-printable encode plaintext mails + set begin_body "This is a multi-part message in MIME format.\n\n--$boundary_string\nContent-Type: text/plain" +###### +# set begin_body "This is a multi-part message in MIME format.\n\n--$boundary_string\nContent-Type: text/plain\nContent-Transfer-Encoding: quoted-printable" +###### + set alternative_body "\n--$boundary_string\nContent-Type: text/html; charset=$mime_charset" + set attachments "\n--$boundary_string\--" + } + } + } + + set mail_text_body "" + set mail_html_body "" + + if {$template_p == "t"} { + # mail is template so generate code to substitute variables in mail text + + # we have to use noquote-substitution in mail subject + while {[regsub -all [template::adp_variable_regexp] $subject {\1@one_user.\2;noquote@} subject]} {} + + if {$mail_mime_type != "text/html"} { + # we have to use noquote-substitution for plaintext emails + while {[regsub -all [template::adp_variable_regexp] $text_body {\1@one_user.\2;noquote@} text_body]} {} + } + + if {$mail_mime_type != "text/plain"} { + # we have to correct for correct variable usage in html emails + # (already done for subject and plaintext emails) + while {[regsub -all [template::adp_variable_regexp] $html_body {\1@one_user.\2@} html_body]} {} + while {[regsub -all [template::adp_variable_regexp_noquote] $html_body {\1@one_user.\2;noquote@} html_body]} {} + } + + ad_conn -set package_key mailing-lists + variable ::template::parse_level + lappend ::template::parse_level [info level] + switch $mail_mime_type { + "text/plain" { + # generate proc to substitute variables in plaintext mails + proc ::mailing_list::__substitute_mail {} " + uplevel { + [template::adp_compile -string $subject] + set mail_subject \$__adp_output + [template::adp_compile -string $text_body] + set mail_text_body \$__adp_output + } + " + } + "text/html" { + # generate proc to substitute variables in html mails + proc ::mailing_list::__substitute_mail {} " + uplevel { + [template::adp_compile -string $subject] + set mail_subject \$__adp_output + [template::adp_compile -string $html_body] + set mail_html_body \$__adp_output + } + " + } + "multipart/alternative" { + # generate proc to substitute variables in alternative mails + proc ::mailing_list::__substitute_mail {} " + uplevel { + [template::adp_compile -string $subject] + set mail_subject \$__adp_output + [template::adp_compile -string $text_body] + set mail_text_body \$__adp_output + [template::adp_compile -string $html_body] + set mail_html_body \$__adp_output + } + " + } + } + template::util::lpop ::template::parse_level + } else { + # mail is no template, so encode once and not for every user + set mail_subject $subject + + # encode plain-text mails + if {$mail_mime_type != "text/html"} { + set mail_text_body $text_body +###### +# set mail_text_body [mail_job::quoted_printable_encode -text $text_body] +###### + } + set mail_html_body $html_body + } + + # get all users to spam from mailing-list / users-selection + if {[empty_string_p $list_id] && ![empty_string_p $bind_vars]} { + # get users from users-selection with bind-vars + set user_list [db_list_of_ns_sets get_users_selection_to_mail_bind $sql_query -bind $bind_vars] + } else { + if {![empty_string_p $list_id]} { + # get users from mailing-list + set user_list [db_list_of_ns_sets get_list_users_to_mail {}] + } else { + # get users from users-selection without bind-vars + set user_list [db_list_of_ns_sets get_users_selection_to_mail $sql_query] + } + } + + set mail_count 0 + # loop over all users to spam + foreach one_user_set $user_list { + incr mail_count + array set one_user [template::util::set_to_list $one_user_set] + set user_id $one_user(user_id) + set user_email $one_user(user_email) + set user_first_names $one_user(user_first_names) + set user_last_name $one_user(user_last_name) + + if {$template_p == "t"} { + # now substitute variables in mailbody + ::mailing_list::__substitute_mail + + # encode plain-text mails + if {$mail_mime_type != "text/html"} { +###### +# set mail_text_body [mail_job::quoted_printable_encode -text $mail_text_body] +###### + } + } + ns_set update $header "X-Field" "$user_id-$mail_job_id" + + # set the data for mail recipient + set to_addr(email) [list $user_email] + set to_addr(user_id) [list $user_id] + if {$user_first_names=="Unknown" && $user_last_name=="User"} { + set to_addr(name) " " + } else { + set to_addr(name) [list "$user_first_names $user_last_name"] + } + + #actually send out the email + switch $mail_mime_type { + "text/plain" { + acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject $mail_subject -body "$begin_body\n$mail_text_body\n$attachments" -extraheaders $header -package_id $package_id +###### +# acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject [mail_job::quoted_printable_encode -text $mail_subject -charset $mime_charset] -body "$begin_body\n$mail_text_body\n$attachments" -extraheaders $header -package_id $package_id +###### + } + "text/html" { + acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject $mail_subject -body "$begin_body\n$mail_html_body\n$attachments" -extraheaders $header -package_id $package_id +###### +# acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject [mail_job::quoted_printable_encode -text $mail_subject -charset $mime_charset] -body "$begin_body\n$mail_html_body\n$attachments" -extraheaders $header -package_id $package_id +###### + } + "multipart/alternative" { + acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject $mail_subject -body "$begin_body\n$mail_text_body\n$alternative_body\n$mail_html_body\n$attachments" -extraheaders $header -package_id $package_id +###### +# acs_mail_lite::send -valid_email -to_addr [array get to_addr] -from_addr $sender_email -subject [mail_job::quoted_printable_encode -text $mail_subject -charset $mime_charset] -body "$begin_body\n$mail_text_body\n$alternative_body\n$mail_html_body\n$attachments" -extraheaders $header -package_id $package_id +###### + } + } + array unset to_addr + + # record mail sending in logtables + db_dml log_mail_sending {} + db_dml log_users_latest_mail {} + } + + # mark mail job as done and save number of mails sent out + # and set link tracking flag if mail containts tracked links + if {$mail_count>0} { + db_dml finish_mail_job {} + + array unset one_user + } + } + + ad_proc -private base64_encode { + -filename:required + } { + set fp [open "|/usr/bin/mmencode -b $filename" r] + set quoted [read $fp] + close $fp + return $quoted + } + + + ad_proc -private quoted_printable_encode { + -text:required + {-charset ""} + } { + Encode special characters, like german umlauts, in message headers + according to RFC 2047. + } { + # First check if there are any characters which need to be quoted at all. + set encode_p 0 + for { set i 0 } { $i < [string length $text] } { incr i } { + if { ![string is ascii [string index $text $i]] } { + set encode_p 1 + } + } + if { !$encode_p } { return $text } + + set hex "0123456789ABCDEF" + + if {[empty_string_p $charset]} { + set end_of_line "=" + set begin_of_line "" + } else { + set end_of_line "?=" + set begin_of_line "=?$charset?Q?" + } + + set result "" + set line $begin_of_line + for { set i 0 } { $i < [string length $text] } { incr i } { + set current [string index $text $i] + if { ![string is ascii $current] || [string first $current " \t\r\n()<>@,;:/\[\]?.=\"\\"] != -1 } { + binary scan $current c x + append line "=[string index $hex [expr ($x & 0xf0) >> 4]][string index $hex [expr $x & 0x0f]]" + } else { + append line $current + } + if { [string length $line] > 70 } { + if { ![empty_string_p $result] } { append result "\n" } + append result "${line}$end_of_line" + set line $begin_of_line + } + } + + if { ![string equal $line $begin_of_line] } { + if { ![empty_string_p $result] } { append result "\n" } + append result "${line}$end_of_line" + } + + return $result + } + + ad_proc -public send_mail { + -to_addr:required + -from_addr:required + -subject:required + -body:required + -mime_type:required + -charset:required + {-package_id ""} + } { + send one email + } { + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] + } + set header [ns_set new] + switch $mime_type { + "text/plain" { + # quoted-printable encode plaintext mails + ns_set put $header "Content-Type" text/plain +###### +# ns_set put $header "Content-Transfer-Encoding" quoted-printable +# set body [mail_job::quoted_printable_encode -text $body] +###### + } + "text/html" { + ns_set put $header "Content-Type" "text/html; charset=$charset" + } + } + + acs_mail_lite::send -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $header -package_id $package_id +###### +# acs_mail_lite::send -to_addr $to_addr -from_addr $from_addr -subject [mail_job::quoted_printable_encode -text $subject -charset $charset] -body $body -extraheaders $header -package_id $package_id +###### + } + + + ad_proc -private mail_bounced { header body } { + Record bounced mail + } { + ns_log notice "mailing lists: try to record bounced mail" + catch { + if {[regexp {X-Field: ([0-9]*)-([0-9]*)} $body match user_id job_id]} { + db_transaction { + ns_log notice "mailing lists: bounce recorded for job $job_id and user $user_id" + db_dml record_bounce_in_log {} + + if {[db_resultrows]} { + db_dml increment_bounce_count {} + } + } + } + } + } + + ad_proc -private create_links { + -text:required + -mime_type:required + -mail_job_id:required + } { + Grab all the links in the given text, insert them into the db and replace + the links in the text with links to the link-tracking package + } { + if {$mime_type == "text/plain"} { + set expression {(http://[a-zA-Z0-9:;_/&=,\#\?\.\-]+)} + set server_url_substitution "[ad_url][mailing_list::util::get_sw_url -package_key mail-links]\\1" + } else { + set expression {href="(http://[^"]*)"} + set server_url_substitution "href=\"[ad_url][mailing_list::util::get_sw_url -package_key mail-links]\\1\"" + } + + while {[regexp $expression $text match url]} { + set link_id [mail_link::add -mail_id $mail_job_id -url $url] + regsub $expression $text "$link_id\.$mail_job_id\.@user_id@" text + } + + regsub -all {([^<]*)} $text $server_url_substitution text + return $text + } + + ad_proc -private sweeper {} { + Periodically send out all waiting mail jobs + } { + # Make sure that only one thread is processing the queue at a time. + if {[nsv_incr mailing_lists send_mails_p] > 1} { + nsv_incr mailing_lists send_mails_p -1 + return + } + + acs_mail_lite::with_finally -code { + set jobs [db_list get_queued_mail_jobs {}] + + foreach job_id $jobs { + send -mail_job_id $job_id + } + } -finally { + nsv_incr mailing_lists send_mails_p -1 + } + } +} Index: openacs-4/contrib/packages/mailing-lists/tcl/email-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/email-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,77 @@ + + + + + + + select j.subject, j.text_body, j.text_header, j.text_footer, + j.html_body, j.html_header, j.html_footer, j.locale, + j.mime_type as mail_mime_type, l.mime_charset, + j.sender_email, j.track_links_p, template_p, + j.css_revision_id, j.list_id, j.selection_id, + j.sql_query, j.bind_vars, j.package_id + from ml_mail_jobs j, ad_locales l + where j.mail_job_id = :mail_job_id + and j.state = 'active' + and l.locale = j.locale + + + + + + + + + select u.user_id, p.first_names as user_first_names, + p.last_name as user_last_name, i.email as user_email + from ml_mailing_list_user_map m, users u, parties i, persons p + where u.user_id = m.user_id + and u.email_bouncing_p = 'f' + and m.list_id = :list_id + and m.subscribed_p = 't' + and i.party_id = u.user_id + and p.person_id = u.user_id + and u.email_verified_p = 't' + and u.email_bouncing_p = 'f' + + + + + + + + + insert into ml_email_log (user_id, mail_job_id) + values (:user_id, :mail_job_id) + + + + + + + + + update ml_mail_jobs + set state = 'finished', + mails_sent = :mail_count, + track_links_p = (select case when count(*) = 0 then 'f' else 't' end + from mail_link_mail_map m + where mail_id = :mail_job_id) + where mail_job_id = :mail_job_id + + + + + + + + + update ml_mail_jobs + set mails_bounced = mails_bounced + 1 + where mail_job_id = :job_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-init.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-init.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,8 @@ +mailing_list::util::reset_cached_package_urls + +# check every 20 minutes for new mail jobs +ad_schedule_proc -thread t 1200 mail_job::sweeper + +nsv_set mailing_lists send_mails_p 0 + +ad_schedule_proc -thread t -schedule_proc ns_schedule_daily [list 1 32] mailing_list::send_reminder Index: openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,190 @@ + + + + oracle8.1.6 + + + + begin + :1 := ml_mailing_list.new ( + list_id => :list_id, + package_id => :package_id, + name => :name, + locale => :locale, + sender_email => :sender_email, + confirm_subject => :confirm_subject, + confirm_mime_type => :confirm_mime_type, + welcome_subject => :welcome_subject, + welcome_mime_type => :welcome_mime_type, + remind_subject => :remind_subject, + remind_mime_type => :remind_mime_type, + expiration_date => $expiration_date, + first_reminder => :first_reminder, + second_reminder => :second_reminder, + context_id => :package_id, + creation_user => :user_id, + creation_ip => :creation_ip); + end; + + + + + + + begin + ml_mailing_list.edit ( + list_id => :list_id, + name => :name, + locale => :locale, + sender_email => :sender_email, + confirm_subject => :confirm_subject, + confirm_mime_type => :confirm_mime_type, + welcome_subject => :welcome_subject, + welcome_mime_type => :welcome_mime_type, + remind_subject => :remind_subject, + remind_mime_type => :remind_mime_type, + expiration_date => $expiration_date, + first_reminder => :first_reminder, + second_reminder => :second_reminder, + modifying_user => :user_id, + modifying_ip => :modifying_ip); + end; + + + + + + + + insert into ml_mailing_list_user_map + (list_id, user_id, confirmed_p, subscribed_p, subscription_date) + values (:list_id, :user_id, :confirmed_p, :confirmed_p, sysdate) + + + + + + + + + select m.user_id, ml.sender_email, ml.remind_subject, + ml.remind_body, ml.remind_mime_type, l.mime_charset, + ml.list_id, n.node_id + from ml_mailing_lists ml, ml_mailing_list_user_map_user_map m, + ad_locales l, site_nodes n + where m.list_id = ml.list_id + and ml.locale = l.locale + and m.confirmed_p = 'f' + and n.object_id = r.package_id + and ((m.reminder_count = 0 + and ml.first_reminder > 0 + and m.subscription_date < sysdate - ml.first_reminder) + or (m.reminder_count = 1 + and ml.second_reminder > 0 + and m.subscription_date < sysdate - ml.second_reminder)) + + + + + + + + + begin + :1 := ml_mail_class.new ( + mail_class_id => :mail_class_id, + package_id => :package_id, + name => :name, + locale => :locale, + sender_email => :sender_email, + subject => :subject, + subject_change_p => :subject_change_p, + text_header_change_p => :text_header_change_p, + text_body_change_p => :text_body_change_p, + text_footer_change_p => :text_footer_change_p, + html_header_change_p => :html_header_change_p, + html_body_change_p => :html_body_change_p, + html_footer_change_p => :html_footer_change_p, + mime_type => :mime_type, + context_id => :package_id, + creation_user => :user_id, + creation_ip => :creation_ip); + end; + + + + + + + + + begin + ml_mail_class.edit ( + mail_class_id => :mail_class_id, + name => :name, + locale => :locale, + sender_email => :sender_email, + subject => :subject, + subject_change_p => :subject_change_p, + text_header_change_p => :text_header_change_p, + text_body_change_p => :text_body_change_p, + text_footer_change_p => :text_footer_change_p, + html_header_change_p => :html_header_change_p, + html_body_change_p => :html_body_change_p, + html_footer_change_p => :html_footer_change_p, + mime_type => :mime_type, + modifying_user => :user_id, + modifying_ip => :modifying_ip); + end; + + + + + + + + begin + :1 := ml_mail_job.new ( + mail_class_id => :class_id, + list_id => :list_id, + selection_id => :selection_id, + package_id => :package_id, + locale => :locale, + sender_email => :sender_email, + track_links_p => :track_links_p, + subject => :subject, + template_p => :template_p, + mime_type => :mime_type, + state => :state, + scheduled_date => $scheduled_date, + bind_vars => :bind_vars, + context_id => :class_id, + creation_user => :user_id, + creation_ip => :creation_ip); + end; + + + + + + + begin + ml_mail_job.edit ( + mail_job_id => :mail_job_id, + locale => :locale, + sender_email => :sender_email, + track_links_p => :track_links_p, + subject => :subject, + template_p => :template_p, + mime_type => :mime_type, + state => :state, + scheduled_date => $scheduled_date, + bind_vars => :bind_vars, + modifying_user => :user_id, + modifying_ip => :modifying_ip); + end; + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,223 @@ + + + + postgresql7.1 + + + + select ml_mailing_list__new ( + :list_id, + :package_id, + :name, + :locale, + :teaser, + :sender_email, + :confirm_subject, + :confirm_body, + :confirm_mime_type, + :welcome_subject, + :welcome_body, + :welcome_mime_type, + :remind_subject, + :remind_body, + :remind_mime_type, + $expiration_date, + :first_reminder, + :second_reminder, + :comments, + :package_id, + :user_id, + current_timestamp, + :creation_ip + ); + + + + + + + select ml_mailing_list__edit ( + :list_id, + :name, + :locale, + :teaser, + :sender_email, + :confirm_subject, + :confirm_body, + :confirm_mime_type, + :welcome_subject, + :welcome_body, + :welcome_mime_type, + :remind_subject, + :remind_body, + :remind_mime_type, + $expiration_date, + :first_reminder, + :second_reminder, + :comments, + :user_id, + :modifying_ip + ); + + + + + + + + insert into ml_mailing_list_user_map + (list_id, user_id, confirmed_p, subscribed_p, subscription_date) + values (:list_id, :user_id, :confirmed_p, :confirmed_p, current_timestamp) + + + + + + + + + select m.user_id, ml.sender_email, ml.remind_subject, + ml.remind_body, ml.remind_mime_type, l.mime_charset, + ml.list_id, n.node_id + from ml_mailing_lists ml, ml_mailing_list_user_map_user_map m, + ad_locales l, site_nodes n + where m.list_id = ml.list_id + and ml.locale = l.locale + and m.confirmed_p = 'f' + and n.object_id = r.package_id + and ((m.reminder_count = 0 + and ml.first_reminder > 0 + and m.subscription_date < (current_timestamp - + (cast (ml.first_reminder || ' days' as interval)) + )) + or (m.reminder_count = 1 + and ml.second_reminder > 0 + and m.subscription_date < (current_timestamp - + (cast (ml.second_reminder || ' days' as interval))) + ) + ) + + + + + + + + + select ml_mail_class__new ( + :mail_class_id, + :package_id, + :name, + :locale, + :sender_email, + :subject, + :subject_change_p, + null, + :text_header_change_p, + null, + :text_body_change_p, + null, + :text_footer_change_p, + null, + :html_header_change_p, + null, + :html_body_change_p, + null, + :html_footer_change_p, + :mime_type, + null, + :package_id, + :user_id, + current_timestamp, + :creation_ip + ); + + + + + + + select ml_mail_class__edit ( + :mail_class_id, + :name, + :locale, + :sender_email, + :subject, + :subject_change_p, + null, + :text_header_change_p, + null, + :text_body_change_p, + null, + :text_footer_change_p, + null, + :html_header_change_p, + null, + :html_body_change_p, + null, + :html_footer_change_p, + :mime_type, + null, + :user_id, + :modifying_ip); + + + + + + + select ml_mail_job__new ( + null, + :class_id, + :list_id, + :selection_id, + :package_id, + :locale, + :sender_email, + :track_links_p, + :subject, + null, + null, + null, + null, + null, + null, + :template_p, + :mime_type, + :state, + $scheduled_date, + :bind_vars, + :class_id, + :user_id, + current_timestamp, + :creation_ip); + + + + + + + select ml_mail_job__edit ( + :mail_job_id, + :locale, + :sender_email, + :track_links_p, + :subject, + null, + null, + null, + null, + null, + null, + :template_p, + :mime_type, + :state, + $scheduled_date, + :bind_vars, + :user_id, + :modifying_ip); + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,322 @@ +ad_library { + Procs for the mailing list manager package. + + @author Timo Hentschel (thentschel@sussdorff-roy.com) + + @creation-date 16 April 2003 + @cvs-id $Id: +} + +namespace eval mailing_list { + + ad_proc -public add { + {-list_id ""} + {-package_id ""} + {-name ""} + {-locale ""} + {-teaser ""} + {-sender_email ""} + {-confirm_subject ""} + {-confirm_body ""} + {-confirm_mime_type "text/plain"} + {-welcome_subject ""} + {-welcome_body ""} + {-welcome_mime_type "text/plain"} + {-remind_subject ""} + {-remind_body ""} + {-remind_mime_type "text/plain"} + {-expiration_date [db_null]} + {-first_reminder 7} + {-second_reminder 0} + {-comments ""} + } { + Creates a new mailing-list + } { + set creation_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] + } + + db_transaction { + set list_id [db_exec_plsql insert_mailing_list {}] + + db_dml set_mailing_list_clobs {} + } + + return $list_id + } + + ad_proc -public edit { + {-list_id:required} + {-name ""} + {-locale ""} + {-teaser ""} + {-sender_email ""} + {-confirm_subject ""} + {-confirm_body ""} + {-confirm_mime_type "text/plain"} + {-welcome_subject ""} + {-welcome_body ""} + {-welcome_mime_type "text/plain"} + {-remind_subject ""} + {-remind_body ""} + {-remind_mime_type "text/plain"} + {-expiration_date [db_null]} + {-first_reminder 7} + {-second_reminder 0} + {-comments ""} + } { + Edits mailing-list + } { + set modifying_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + + db_transaction { + db_exec_plsql update_mailing_list {} + + db_dml set_mailing_list_clobs {} + } + } + + ad_proc -public user_subscribed_p { + -list_id:required + -user_id:required + } { + Checks if a user is already subscribed to a list + } { + return [db_0or1row check_user_entry_exists {}] + } + + ad_proc -public add_user { + -list_id:required + -user_id:required + {-confirmed_p t} + } { + Add a user to a mailing list + } { + # try to add new user map entry + # if it fails, the user is already subscribed or unsubscribed by his own choice + if {![user_subscribed_p -list_id $list_id -user_id $user_id]} { + db_dml add_user_entry {} + catch { + db_dml add_user_log_entry {} + } + return 1 + } else { + return 0 + } + } + + ad_proc -private send_reminder {} { + Sends a reminder email to users not having confirmed the + mass subscribtion + } { + set reminders [db_list_of_lists get_unconfirmed_subscriptions {}] + + # send reminder + foreach reminder $reminders { + util_unlist $reminder user_id sender_email remind_subject remind_body remind_mime_type mime_charset list_id node_id + set confirmation_link "[ad_url][site_node::get_url -node_id $node_id]confirm?[export_url_vars list_id]" + + mailing_list::util::send_mail -user_id $user_id -from_email $sender_email -subject $remind_subject -body $remind_body -mime_type $remind_mime_type -charset $mime_charset -link $confirmation_link + + ns_log Notice "List subscription reminder sent to user $user_id" + + # log sending the reminder mail + db_dml log_reminder_sending {} + } + } +} + +namespace eval mail_class { + + ad_proc -public add { + {-mail_class_id ""} + {-package_id ""} + {-name ""} + {-locale ""} + {-sender_email ""} + {-subject ""} + {-subject_change_p t} + {-text_header ""} + {-text_header_change_p t} + {-text_body ""} + {-text_body_change_p t} + {-text_footer ""} + {-text_footer_change_p t} + {-html_header ""} + {-html_header_change_p t} + {-html_body ""} + {-html_body_change_p t} + {-html_footer ""} + {-html_footer_change_p t} + {-mime_type "text/plain"} + {-comments ""} + } { + Creates a new mail-class + } { + set creation_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] + } + + db_transaction { + set mail_class_id [db_exec_plsql insert_mail_class {}] + + db_dml set_mail_class_clobs {} + } + + return $mail_class_id + } + + ad_proc -public edit { + {-mail_class_id:required} + {-name ""} + {-locale ""} + {-sender_email ""} + {-subject ""} + {-subject_change_p t} + {-text_header ""} + {-text_header_change_p t} + {-text_body ""} + {-text_body_change_p t} + {-text_footer ""} + {-text_footer_change_p t} + {-html_header ""} + {-html_header_change_p t} + {-html_body ""} + {-html_body_change_p t} + {-html_footer ""} + {-html_footer_change_p t} + {-mime_type "text/plain"} + {-comments ""} + } { + Edits mail-class + } { + set modifying_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + + db_transaction { + db_exec_plsql update_mail_class {} + + db_dml set_mail_class_clobs {} + } + } +} + +namespace eval mail_job { + + ad_proc -public add { + {-class_id:required} + {-list_id:required} + {-selection_id:required} + {-locale ""} + {-sender_email ""} + {-track_links_p f} + {-subject ""} + {-text_header ""} + {-text_body ""} + {-text_footer ""} + {-html_header ""} + {-html_body ""} + {-html_footer ""} + {-template_p f} + {-mime_type "text/plain"} + {-state active} + {-scheduled_date [db_null]} + {-bind_vars ""} + } { + Creates a new mail-job + } { + set creation_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + set package_id [ad_conn package_id] + + db_transaction { + set mail_job_id [db_exec_plsql insert_mail_job {}] + + db_dml set_email_clobs {} + + if {![empty_string_p $selection_id]} { + db_1row get_users_selection_query {} + + db_dml set_selection_query {} + } + } + + return $mail_job_id + } + + ad_proc -public edit { + {-mail_job_id:required} + {-locale ""} + {-sender_email ""} + {-track_links_p f} + {-subject ""} + {-text_header ""} + {-text_body ""} + {-text_footer ""} + {-html_header ""} + {-html_body ""} + {-html_footer ""} + {-template_p f} + {-mime_type "text/plain"} + {-state active} + {-scheduled_date [db_null]} + {-bind_vars ""} + } { + Edits a mail-job + } { + set modifying_ip [ad_conn peeraddr] + set user_id [ad_conn user_id] + + db_transaction { + db_exec_plsql update_mail_job {} + + db_dml set_email_clobs {} + } + } + + ad_proc -private after_install {} { + Callback to be called after package installation. + Adds the service contract implementations for bounce-management. + + @author Timo Hentschel (thentschel@sussdorff-roy.com) + } { + acs_sc::impl::new -contract_name AcsMailLite -name mailing_lists -owner mailing_lists + acs_sc::impl::alias::new -contract_name AcsMailLite -impl_name mailing_lists -operation MailBounce -alias mail_job::mail_bounced + acs_sc::impl::binding::new -contract_name AcsMailLite -impl_name mailing_lists + } + + ad_proc -private before_uninstall {} { + Callback to be called before package uninstallation. + Removes the service contract implementations for bounce-management. + + @author Timo Hentschel (thentschel@sussdorff-roy.com) + } { + # shouldn't we first delete the bindings? + acs_sc::impl::delete -contract_name AcsMailLite -impl_name mailing_lists + } +} + + +# procs for acsobject service contract +ad_proc -public ml_get_mailing_list_pageurl { object_id } { + Returns the page that displays a mailing-list +} { + return "madmin/lists?list_id=$object_id" +} + +ad_proc -public ml_get_mail_job_pageurl { object_id } { + Returns the page that displays a mail-job +} { + return "madmin/jobs?mail_job_id=$object_id" +} + +ad_proc -public ml_get_mail_class_pageurl { object_id } { + Returns the page that displays a mail-class +} { + return "madmin/classes?class_id=$object_id" +} Index: openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,158 @@ + + + + + + + update ml_mailing_lists + set teaser = :teaser, + confirm_body = :confirm_body, + welcome_body = :welcome_body, + remind_body = :remind_body, + comments = :comments + where list_id = :list_id + + + + + + + + + update ml_mailing_lists + set teaser = :teaser, + confirm_body = :confirm_body, + welcome_body = :welcome_body, + remind_body = :remind_body, + comments = :comments + where list_id = :list_id + + + + + + + + + insert into ml_user_email_log (user_id, last_mail_date) + (select :user_id as user_id, null as last_mail_date + from dual + where not exists (select 1 from ml_user_email_log + where user_id = :user_id)) + + + + + + + + + update ml_mailing_list_user_map + set reminder_count = reminder_count + 1 + where user_id = :user_id + + + + + + + + + select 1 + from ml_mailing_list_user_map + where list_id = :list_id + and user_id = :user_id + + + + + + + + + update ml_mail_classes + set text_header = :text_header, + text_body = :text_body, + text_footer = :text_footer, + html_header = :html_header, + html_body = :html_body, + html_footer = :html_footer, + comments = :comments + where mail_class_id = :mail_class_id + + + + + + + + + update ml_mail_classes + set text_header = :text_header, + text_body = :text_body, + text_footer = :text_footer, + html_header = :html_header, + html_body = :html_body, + html_footer = :html_footer, + comments = :comments + where mail_class_id = :mail_class_id + + + + + + + + + update ml_mail_jobs + set text_header = :text_header, + text_body = :text_body, + text_footer = :text_footer, + html_header = :html_header, + html_body = :html_body, + html_footer = :html_footer + where mail_job_id = :mail_job_id + + + + + + + + + select full_sql + from us_selections + where selection_id = :selection_id + + + + + + + + + update ml_mail_jobs + set sql_query = :full_sql + where mail_job_id = :mail_job_id + + + + + + + + + update ml_mail_jobs + set text_header = :text_header, + text_body = :text_body, + text_footer = :text_footer, + html_header = :html_header, + html_body = :html_body, + html_footer = :html_footer + where mail_job_id = :mail_job_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/util-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/util-procs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,20 @@ + + + + oracle8.1.6 + + + + + select site_node.url(n.node_id) as package_url, p.package_key + from site_nodes n, site_nodes top, apm_packages p + where top.parent_id is null + and n.parent_id = top.node_id + and p.package_id = n.object_id + and p.package_key in ('users-selection', 'categories', 'mail-links', 'mailing-lists') + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/util-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/util-procs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,20 @@ + + + + postgresql7.1 + + + + + select site_node__url(n.node_id) as package_url, p.package_key + from site_nodes n, site_nodes top, apm_packages p + where top.parent_id is null + and n.parent_id = top.node_id + and p.package_id = n.object_id + and p.package_key in ('users-selection', 'categories', 'mail-links', 'mailing-lists') + + + + + + Index: openacs-4/contrib/packages/mailing-lists/tcl/util-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/util-procs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,200 @@ +namespace eval mailing_list::util { + + ad_proc -private reset_cached_package_urls {} { + Caches the urls of the site-wide package instances of + categories and users-selection + } { + catch {nsv_unset ml_cached_urls} + + db_foreach get_site_wide_package_urls {} { + nsv_set ml_cached_urls $package_key $package_url + } + } + + ad_proc -public get_sw_url { + -package_key:required + } { + Returns the cached url of a site-wide package + } { + if {[catch {set url [nsv_get ml_cached_urls $package_key]}]} { + # no url found + return + } + return $url + } + + ad_proc -public text_contains_tcl_code { + -text:required + } { + Checks if text contains malicious inline-tcl code (adp-style) + } { + if {[regexp {<%[^=](.*?)%>} $text match tcl_code] || [regexp {<%=.*?(\[.*?)%>} $text match tcl_code]} { + return 1 + } + return 0 + } + + ad_proc -public check_valid_vars { + -text:required + -valid_vars:required + } { + Checks if the template vars used in a text are all valid + in the sense that they all can be found the provided list. + } { + # get list of used variables + set current_index 0 + while {[regexp -indices -start $current_index [template::adp_variable_regexp] $text match match found_variable]} { + set current_index [expr [lindex $found_variable 1] + 1] + set user_variable [string range $text [lindex $found_variable 0] [lindex $found_variable 1]] + set used_vars($user_variable) 1 + } + + set errors "" + # check if used variables are all valid + foreach used_var [array names used_vars] { + if {[lsearch -exact $valid_vars $used_var] == -1} { + # used var not a valid one + lappend errors $used_var + } + } + return $errors + } + + ad_proc -public send_mail { + -user_id:required + -from_email:required + -subject:required + -body:required + -mime_type:required + -charset:required + {-link ""} + {-new_password ""} + } { + Sends the confirmation/welcome mail to a user + } { + if {[empty_string_p $body]} { + # don't send any mail if message is empty + return + } + + db_1row get_user_data {} + + # generate the x-variable that's needed to verify the users identity + # when he clicks the link + set x [ns_sha1 "$user_id $user_password $user_salt"] + append link "&[export_url_vars x]" + + # if user is already known to the system and not newly generated, + # leave password blank so that a in + # the mail text will not get executed (intended to provide + # the user_password in the email to new users) + set user_password $new_password + + # we have to use noquote-substitution for plaintext emails + if {$mime_type == "text/plain"} { + while {[regsub -all [template::adp_variable_regexp] $body {\1@\2;noquote@} body]} {} + } + + # substitute template variables in confirmation email + variable ::template::parse_level + lappend ::template::parse_level [info level] + set error_p 0 + with_catch __errmsg { + set __result [template::adp_compile -string $body] + template::adp_eval __result + set body $__adp_output + } { + # substitution failed + set error_p 1 + } + template::util::lpop ::template::parse_level + + set to_addr(email) [list $user_email] + set to_addr(user_id) [list $user_id] + set to_addr(name) [list $user_name] + + if {!$error_p} { + # now send the mail + ns_log notice "mime_type: $mime_type / charset: $charset" + mail_job::send_mail -to_addr [array get to_addr] -from_addr $from_email -subject $subject -body $body -mime_type $mime_type -charset $charset -package_id [ad_conn package_id] + } + return $error_p + } + + ad_proc -public valid_x_field_p { + -user_id:required + -x_field:required + } { + Verifies the x-field in the users email + } { + db_1row get_user_data {} + + # generate the expected x-variable + set expected_x [ns_sha1 "$user_id $user_password $user_salt"] + + # Check if both values are the same and return t or f + return [string equal $x_field $expected_x] + } + + ad_proc -public check_valid_country_codes { + -emails_and_countries:required + } { + Checks the csv-list of emails and countries for valid country codes + and returns list of emails with invalid country codes + } { + # get all mappings country_code -> country_id so that we can check + # a lot easier + db_foreach get_country_codes {} { + set country_id($country_code) $category_id + } + + # generate tmp-file for csv-processing + set tmp_file [ns_tmpnam] + set fd [open $tmp_file w] + puts $fd $emails_and_countries + close $fd + set fd [open $tmp_file r] + + set invalid_list "" + + # process every line of the user/country list + while {[ns_getcsv $fd line] > 0} { + # grap the email and country of the current line + util_unlist $line email country + + if {[empty_string_p $country] || ![exists_and_not_null country_id($country)]} { + # empty or invalid country code + lappend invalid_list $email + } + } + return $invalid_list + } + + ad_proc -public check_valid_emails { + -emails_and_countries:required + } { + Checks the csv-list of emails and countries for valid email addresses + and returns list of invalid emails + } { + # generate tmp-file for csv-processing + set tmp_file [ns_tmpnam] + set fd [open $tmp_file w] + puts $fd $emails_and_countries + close $fd + set fd [open $tmp_file r] + + set invalid_list "" + + # process every line of the user/country list + while {[ns_getcsv $fd line] > 0} { + # grap the email and country of the current line + util_unlist $line email country + + if {![util_email_valid_p $email]} { + # invalid email address + lappend invalid_list $email + } + } + return $invalid_list + } +} Index: openacs-4/contrib/packages/mailing-lists/tcl/util-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/tcl/util-procs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,44 @@ + + + + + + + select u.password as user_password, u.salt as user_salt, + p.first_names || ' ' || p.last_name as user_name, + y.email as user_email + from users u, persons p, parties y + where u.user_id = :user_id + and p.person_id = u.user_id + and y.party_id = u.user_id + + + + + + + + + select u.password as user_password, u.salt as user_salt, + p.first_names || ' ' || p.last_name as user_name, + y.email as user_email + from users u, persons p, parties y + where u.user_id = :user_id + and p.person_id = u.user_id + and y.party_id = u.user_id + + + + + + + + + select country_code, category_id + from ml_country_codes + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/confirm-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/confirm-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/confirm-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,20 @@ + + + + oracle8.1.6 + + + + + update ml_mailing_list_user_map + set confirmed_p = 't', + subscribed_p = 't', + subscription_date = sysdate + where user_id = :user_id + and list_id = :list_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/confirm-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/confirm-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/confirm-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,20 @@ + + + + postgresql7.1 + + + + + update ml_mailing_list_user_map + set confirmed_p = 't', + subscribed_p = 't', + subscription_date = current_timestamp + where user_id = :user_id + and list_id = :list_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/confirm.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/confirm.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/confirm.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,9 @@ + +Mailing Lists Confirmation +@context_bar;noquote@ + + +

Welcome to the "@name@" Mailing List!

+
+

Invalid secret key!

+
Index: openacs-4/contrib/packages/mailing-lists/www/confirm.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/confirm.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/confirm.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,41 @@ +ad_page_contract { + Confirms user to a mailing list +} { + list_id:integer,notnull + x:notnull + user_id:optional +} + +if {[exists_and_not_null user_id] && [exists_and_not_null x]} { + # user most likely clicked a link in an email + # verify the secret key and try to login the user + if {[mailing_list::util::valid_x_field_p -user_id $user_id -x_field $x]} { + # secret key ok, login user + ad_user_login -forever=0 $user_id + } else { + # could not verify the secret key for that user + ad_return_complaint 1 "Invalid secret key" + return + } +} else { + set user_id [ad_maybe_redirect_for_registration] +} + +set package_id [ad_conn package_id] + +set context_bar [list "Confirm"] +set valid_x_p [mailing_list::util::valid_x_field_p -user_id $user_id -x_field $x] + +if {$valid_x_p} { + db_transaction { + db_dml confirm_email_address {} + + db_dml confirm_list_subscribtion {} + + db_1row get_list_name {} + } +} else { + ns_log notice "Invalid secret key of user $user_id when confirming for list $list_id" +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/confirm.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/confirm.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/confirm.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,26 @@ + + + + + + + update users + set email_verified_p = 't' + where user_id = :user_id + + + + + + + + + select name + from ml_mailing_lists + where list_id = :list_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,43 @@ + + + + oracle8.1.6 + + + + + select l.list_id, l.name + from ml_mailing_lists l, ml_mailing_list_user_map m + where l.package_id = :package_id + and l.list_id = m.list_id + and l.expiration_date > sysdate + and m.user_id = :user_id + and m.subscribed_p = 't' + order by lower(l.name) + + + + + + + + select l.list_id, l.name, l.teaser, c.tree_id, c.category_id, + nvl(m.subscribed_p, 'f') as subscribed_p + from ml_mailing_lists l, ml_mailing_list_user_map m, + category_object_map cm, categories c, ml_category_trees_visible v + where l.package_id = :package_id + and l.list_id = m.list_id(+) + and m.user_id(+) = :user_id + and l.public_p = 't' + and l.locale = :locale + and l.expiration_date > sysdate + and cm.object_id = l.list_id + and cm.category_id = c.category_id + and v.package_id = :package_id + and v.tree_id = c.tree_id + order by c.tree_id, c.category_id, lower(l.name) + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/index-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/index-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,44 @@ + + + + postgresql7.1 + + + + + select l.list_id, l.name + from ml_mailing_lists l, ml_mailing_list_user_map m + where l.package_id = :package_id + and l.list_id = m.list_id + and l.expiration_date > current_timestamp + and m.user_id = :user_id + and m.subscribed_p = 't' + order by lower(l.name) + + + + + + + + select l.list_id, l.name, l.teaser, c.tree_id, c.category_id, + coalesce(m.subscribed_p, 'f') as subscribed_p + from ml_mailing_lists l + left outer join ml_mailing_list_user_map m + on (l.list_id = m.list_id and m.user_id = :user_id) + inner join category_object_map cm + on (cm.object_id = l.list_id) + inner join categories c using (category_id) + inner join ml_category_trees_visible v using (tree_id) + where l.package_id = :package_id + and l.public_p = 't' + and l.locale = :locale + and l.expiration_date > current_timestamp + and v.package_id = :package_id + order by c.tree_id, c.category_id, lower(l.name) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/index.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,51 @@ + +Mailing Lists Index +@context_bar;noquote@ + + + + + + +

Mailing Lists you are already subscribed to

+
+ +
    + +
  • @subscribed_lists.name@
  • +
    +
+ +
+
+ +
+ + +
+ +

Available Mailing Lists

+ +
+
    + +

    @lists.tree_name@

    + + @lists.category_name@
      + +
    • @lists.name@ +
      @lists.teaser@
    • +
      +
    +
    +
    +
+ +
+
+ No mailing lists available in this language. + Index: openacs-4/contrib/packages/mailing-lists/www/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/index.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,49 @@ +ad_page_contract { +} { + locale:optional + user_id:optional + x:optional +} -properties { + lists:multirow + jobs:multirow +} + +if {[exists_and_not_null user_id] && [exists_and_not_null x]} { + # user most likely clicked a link in an email + # verify the secret key and try to login the user + if {[mailing_list::util::valid_x_field_p -user_id $user_id -x_field $x]} { + # secret key ok, login user + ad_user_login -forever=0 $user_id + } else { + # could not verify the secret key for that user + ad_return_complaint 1 "Invalid secret key" + return + } +} else { + set user_id [ad_maybe_redirect_for_registration] +} + +set package_id [ad_conn package_id] +set admin_p [permission::permission_p -object_id $package_id -privilege mailing_list_admin] + +if {![info exists locale]} { + set locale [ad_conn locale] +} + +db_multirow subscribed_lists get_lists_user_is_subscribed {} + +template::multirow create lists list_id name teaser tree_id tree_name category_id category_name + +db_foreach get_lists_by_language {} { + if {$subscribed_p == "f"} { + set category_name [category::get_name $category_id] + set tree_name [category_tree::get_name $tree_id] + template::multirow append lists $list_id $name $teaser $tree_id $tree_name $category_id $category_name + } +} + +db_multirow languages get_languages {} + +set context_bar "" + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/index.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/index.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,14 @@ + + + + + + + select label, locale + from ad_locales + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,43 @@ + + + + oracle8.1.6 + + + + + update ml_mailing_list_user_map + set subscribed_p = 'f', + unsubscription_date = sysdate + where list_id = :list_id + and user_id = :user_id + + + + + + + + + insert into ml_mailing_list_user_map + (list_id, user_id, subscribed_p, subscription_date) + values (:list_id, :user_id, 't', sysdate) + + + + + + + + + update ml_mailing_list_user_map + set subscribed_p = 't', + subscription_date = sysdate + where list_id = :list_id + and user_id = :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,43 @@ + + + + postgresql7.1 + + + + + update ml_mailing_list_user_map + set subscribed_p = 'f', + unsubscription_date = current_timestamp + where list_id = :list_id + and user_id = :user_id + + + + + + + + + insert into ml_mailing_list_user_map + (list_id, user_id, subscribed_p, subscription_date) + values (:list_id, :user_id, 't', current_timestamp) + + + + + + + + + update ml_mailing_list_user_map + set subscribed_p = 't', + subscription_date = current_timestamp + where list_id = :list_id + and user_id = :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,41 @@ +ad_page_contract { + Subscribes or unsubscribes a user to a mailing list +} { + {list_ids:multiple,notnull ""} + unsubscribe:optional +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] + +if {[info exists unsubscribe]} { + # unsubscribe user. i assume that this user currently is subscribed + db_transaction { + template::util::list_to_lookup $list_ids lists + foreach list_id [array names lists] { + db_dml unsubscribe_user {} + } + } +} else { + #subscribe user. check if user already has a map entry + db_transaction { + template::util::list_to_lookup $list_ids lists + foreach list_id [array names lists] { + if {![db_0or1row check_user_entry_exists {}]} { + # add new user map entry + db_dml add_user_entry {} + } else { + # update old user map entry + db_dml subscribe_user {} + } + db_1row get_welcome_text {} + + set unsubscribe_link "[ad_url][ad_conn package_url]?[export_url_vars user_id]" + + # send welcome email + mailing_list::util::send_mail -user_id $user_id -from_email $sender_email -subject $welcome_subject -body $welcome_body -mime_type $welcome_mime_type -charset $mime_charset -link $unsubscribe_link + } + } +} + +ad_returnredirect "." Index: openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,30 @@ + + + + + + + select 1 + from ml_mailing_list_user_map + where list_id = :list_id + and user_id = :user_id + + + + + + + + + select l.sender_email, l.welcome_subject, l.welcome_body, + l.welcome_mime_type, p.email as user_email, o.mime_charset + from ml_mailing_lists l, ad_locales o, parties p + where l.list_id = :list_id + and o.locale = l.locale + and p.party_id = :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/master.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/master.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,5 @@ + +@title;noquote@ +@context_bar;noquote@ + + Index: openacs-4/contrib/packages/mailing-lists/www/master.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/master.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/master.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,4 @@ +# There seems to be no way to elegantly set default values here +if { ![info exists context_bar] } { + set context_bar "" +} Index: openacs-4/contrib/packages/mailing-lists/www/doc/index.html =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/doc/index.html,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/doc/index.html 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,207 @@ +User Documentation for Mailing List Manager + +

User Documentation for Mailing List Manager

+ +After installing mailing-lists, categories, users-selection, +acs-mail-lite, mail-links and acs-datetime, you should first +deal with categories so that you can later categorize +mailing-lists in several dimensions (called category trees). +According to the spec, greenpeace will categorize mailing lists +in the dimensions region (i.e. united states, germany...), +campaign (i.e. rainforest, whales, war...) and target (i.e. press, +cyberactivists...), but other dimensions (trees) can be added. + +

+ +To setup these categories, you use the admin interface of the +categories package to add category trees - let's say 'regions'. +Then you can add top-level nodes to this tree - like 'north america', +'europe'. After that, you can add child nodes to these categories +- like 'germany' and 'france' in europe and 'united states' in +north america. Since the category package is multilingual, +you can select a different language from the select box and +start translating the categories by editing them. Later, a user +will see then see the categories in the default language that he set +in his settings. + +

+ +After you setup some category trees, you can use the context bar to +go to 'Main Site' and then to the mailing list package. At the top +of the admin interface, you can now use the link 'Administer +Categories' to come back to the categories package to now mount +some of your created category trees to the mailing list package +so that they can be used to categorize lists. You can choose to use +whole trees or only subtrees (you then have to select where the +subtree should start), but you normally would use a whole tree. + +

+ +After you mapped your trees to mailing lists, use the context bar +to come back to the mailing list package. By using the link +'Change Visible Categories' you can select, which category trees +should be seen by users when browsing to look for other interesting +lists (for example, you may want to decide that the users can +only look through the list of existing mailing lists by region +and by campaign, not by target). + +

+ +The categorization system is also used to store the information +which user is coming from which country. To tell the system +which category tree to use for this user categorization +(the regions tree), you have to use the link 'Change Country +Category'. + +

+ +Since the mass subscribtion will be done by providing a list +if emails and country codes, the system will have to know which +country is meant by what country code. This mapping can be done +by using the link 'Administer Country Codes'. + +

+ +The mailing list manager can not only be used to spam mailing lists +for which users have signed up, but also to spam a list of users +selected by a custom sql query. These sql queries can be managed +by the users selections package. In this package, an admin can +write sql queries containing bind variables for which he provides +default values. These queries can be administered and their +results tested for different bind variable data by using the link +'Administer Users Selections'. + + +

Mailing Lists

+ +When adding a new mailing list, the user has to provide a name, +select the language the list will be in, enter some teaser text +to be displayed in the users list of available mailing lists and +categorize the list in the category trees mapped to this +mailing list package. In addition to that, the user has to provide +data for the confirmation-, welcome- and reminder-emails sent out by +the system: The emails need a sender email address, a subject, +a body and a mime-type (either plaintext or html). Since the user +being mass subscribed to a mailing list is not yet known to the +system, it is not possible to use dynamic variables like +@user_first_names@ that will be replaced by the users first name +(you can do that in the mail jobs or mail classes later). + +

+ +To include a link to confirm the subscribtion, you can use @link@ +in the confirmation- and reminder-emails. To tell a newly added +user his password in the confirmation- or welcome-email (we can't +figure out the password when sending reminder emails since they +are stored encrypted) you should use code like + +

<if @user_password@ not nil> Your new password is: @user_password@ </if>
+ +Further data for mailing lists are the date when the mailinglist +will expire (just set it to some date in the far future if no +expiration date needed) and the number of days after a user +received the first mail to confirm the subscribtion to a new +mailing-list that a reminder email will be sent out. For example, +if you set the 1st reminder to 7, then the user will be reminded +after a week to confirm the subscribtion. If you want to remind +only once, just enter 0 as 2nd reminder. After all that, you can +enter some comment to that new mailing list to maybe explain +some other admin what this is all about. + +

+ +After the creation of a mailing list, you will see it at the index +page together with the information how many users are subscribed +to it or still need to confirm the subscribtion and you will see +links to delete that mailing list and manage the permissions to it. +You can edit the mailing list data by clicking on the lists name. +When managing permissions, you can make a list public to all +mailing list admins (so they can use and edit it), or you can grant +some other specific other admins the rights to use and/or edit it. +The list of other admins will contain only those admins that are +not general mailing-list package-admins, because they can always +see and edit all mailing lists or mail classes. + +

+ +If you want to mass subscribe some users, you have to select to +which list you want them to be subscribed and provide a comma +seperated list (csv) of emails and contry codes (see administring +country codes) and check if you want them to be asked for +confirmation or if you just want them to be immediately subscribed. +The users will then either receive a confirmation email or a +welcome email. If an email is not known yet, a new user will be +created. + + +

Mail Classes

+ +A mail class is a template for a new mail to a mailing list or a +users selection. When creating a new mail class, you have to +choose if you want the mail class to be a template for a plaintext +email, a html email or a mixed email with both a plaintext and +a html part. After that, you will see the form asking to provide +a name, a language the mail will be in, a sender email address, +a subject, header, body and footer for the mail. The header and +footer can be used to set a fixed beginning and end for a mail +framing a mail-specific body. Please note that there will be no +additional newline or anything inserted between these three parts. +The user can also define in a mail class if the subject, header, +body and footer can later be changed when actually using the mail +class in a mail job or if they will be fixed. Further, a css-file +can be uploaded and attached to a mail class and comments can be +given to other editing admins. + +

+ +After creating a mail class, you can edit, delete or copy this +class or manage the permissions for it - just as for mailing lists. + + +

Mail Jobs

+ +When creating a new mail job, you will be asked which mail +class you want to use and which mailing list or which users +selection you want to spam. Then you will see the mail job +form where you can set the language of this mail job, change +the sender email and edit the mail subject, header, body and +footer - if the used mail class lets you do that. When spamming +a mailing list you can use the variables @user_id@, @user_email@, +@user_first_names@ and @user_last_name@ which will be dynamically +replaced with the appropriate data for every user. When spamming +a user-selection, you can change the used bind vars of the query +if some exist and you can use all query columns of the query in +the form @column_name@ in the mail text. In addition to that, +you can upload and delete mail attachments (the css-file of the +mail class will be shown if it has one). To upload a new +attachment, you have to use the ok-button of the form and you +will get to the same form again and again until you don't upload +a new attachment. After uploading all atachments, you can decide +if you want links used in the mail text to be tracked so that +every click of users to these links will be recorded by the system. + +

+ +If you use this feature, the system will look for links beginning +with http:// in the plaintext part of the mail and for links like +href="http:// in the html part. In the end, you can set the execution +date (default: mail will be send in the next 20 minutes) and +set the mail job's status as active or suspended. Please note that +when uploading attachments, the status will be automatically set +to suspended and you therefore need to set it to active again when +finally submitting the mail job. Before the mail job gets created, +you will see a confirmation page showing you the final email. + +

+ +You can see pending mail jobs by using the link 'Pending Mail Jobs'. +Here you can edit the mail jobs, delete, suspend and activate them. +Processed mail jobs can be found by using the 'Mail Job History'. +By using the 'Mail Links' link for mail jobs found, you can then +see how many users clicked which link in the mail. + +
+ + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,28 @@ +ad_page_contract { + + Displays the country category tree and lets user map country codes + (to be used in mass subscribtion) + + @author Timo Hentschel (thentschel@sussdorff-roy.com) + @cvs-id $Id: +} { + country_codes:array +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +db_transaction { + db_dml delete_old_country_codes {} + + foreach category_id [array names country_codes] { + set country_code [string tolower $country_codes($category_id)] + + if {![empty_string_p $country_code]} { + db_dml insert_country_code {} + } + } +} + +ad_returnredirect "." Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code-2.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,23 @@ + + + + + + + delete from ml_country_codes + + + + + + + + + insert into ml_country_codes (country_code, category_id) + values (:country_code, :category_id) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,28 @@ + +Administer Country Codes +@context_bar;noquote@ + + + +

+ + + + + + + + + + +
Country Name Country Code
+ @one_tree.left_indent;noquote@ @one_tree.category_name@ + + @one_tree.left_indent;noquote@ +
+
+ +
+ + no countries have been created... + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,41 @@ +ad_page_contract { + + Displays the country category tree and lets user map country codes + (to be used in mass subscribtion) + + @author Timo Hentschel (thentschel@sussdorff-roy.com) + @cvs-id $Id: +} { +} -properties { + context_bar:onevalue + one_tree:multirow +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set context_bar [list [list "." Administration] "Country Codes"] + +if {![db_0or1row get_current_country_category_tree {}]} { + # no country tree mapped, so return to index page immediately + ad_returnredirect "." + return +} + +db_foreach get_country_codes {} { + set country_codes($category_id) $country_code +} + +template::multirow create one_tree category_name country_code category_id deprecated_p level left_indent + +foreach category [category_tree::get_tree -all $tree_id] { + util_unlist $category category_id category_name deprecated_p level + if {[catch {set country_code $country_codes($category_id)}]} { + set country_code "" + } + + template::multirow append one_tree $category_name $country_code $category_id $deprecated_p $level [category::repeat_string " " [expr ($level-1)*5]] +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country-code.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,25 @@ + + + + + + + select tree_id + from ml_country_category_tree + where package_id = :package_id + + + + + + + + + select category_id, country_code + from ml_country_codes + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,7 @@ + +Change Country Category +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,31 @@ +ad_page_contract { + Let user select the country category trees +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set context_bar [list [list "." Administration] "Country Category"] +set category_trees [list] + +db_foreach get_mapped_category_trees {} { + lappend category_trees [list [category_tree::get_name $tree_id] $tree_id] +} + +set country_tree [db_string get_current_country_category_tree {} -default ""] + +ad_form -name country_category_form -action categories-country -form { + {country_tree_id:text(radio) {label "Country Category"} {values $country_tree} {options $category_trees}} +} -on_submit { + db_transaction { + db_dml delete_country_category_tree {} + + db_dml insert_country_category_tree {} + } +} -after_submit { + ad_returnredirect "." + ad_script_abort +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-country.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,46 @@ + + + + + + + select tree_id + from category_tree_map + where object_id = :package_id + + + + + + + + + select tree_id + from ml_country_category_tree + where package_id = :package_id + + + + + + + + + delete from ml_country_category_tree + where package_id = :package_id + + + + + + + + + insert into ml_country_category_tree (tree_id, package_id) + values (:country_tree_id, :package_id) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,7 @@ + +Change Categories Shown to User +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,35 @@ +ad_page_contract { + Let user select the category trees that should be visible to users +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set context_bar [list [list "." Administration] "Visible Categories"] +set category_trees [list] + +# get all mapped category trees +db_foreach get_mapped_category_trees {} { + lappend category_trees [list [category_tree::get_name $tree_id] $tree_id] +} + +ad_form -name show_categories_form -action categories-show -form { + {show_tree_id:text(checkbox),multiple,optional {label "Show Categories"} {options $category_trees}} +} -on_request { + # get all currently visible category trees + set show_tree_id [db_list get_category_trees_currently_shown {}] +} -on_submit { + db_transaction { + db_dml delete_shown_category_trees {} + + foreach tree_id $show_tree_id { + db_dml show_category_tree {} + } + } +} -after_submit { + ad_returnredirect "." + ad_script_abort +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/categories-show.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,46 @@ + + + + + + + select tree_id + from category_tree_map + where object_id = :package_id + + + + + + + + + select tree_id + from ml_category_trees_visible + where package_id = :package_id + + + + + + + + + delete from ml_category_trees_visible + where package_id = :package_id + + + + + + + + + insert into ml_category_trees_visible (tree_id, package_id) + values (:tree_id, :package_id) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,14 @@ + +New Mail Class +@context_bar;noquote@ + +

Please specify if you want to use both Plaintext and HTML or single +content type

+

+

+ Plaintext
+ HTML
+ Both Plaintext and HTML +

+ +

Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-add.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,10 @@ +ad_page_contract { +} { +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set context_bar [list [list "." Administration] "Add Mail Class"] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,17 @@ + + + + oracle8.1.6 + + + + + begin + ml_mail_class.delete(:class_id); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,13 @@ + + + + postgresql7.1 + + + + select ml_mail_class__delete(:class_id); + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,24 @@ +ad_page_contract { +} { + class_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $class_id -privilege admin + +db_transaction { + set pending_jobs [db_string check_for_pending_jobs {}] + + if {$pending_jobs == 0} { + # only delete if there're no pending mail jobs + db_exec_plsql delete_mail_class {} + } +} + +if {$pending_jobs > 0} { + ad_return_error "Pending Mail Jobs" "There are still pending mail jobs for this mail class. You can't delete this class until they are processed." + return +} + +ad_returnredirect "." Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete-2.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + select count(*) + from ml_mail_jobs + where mail_class_id = :class_id + and state = 'pending' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,20 @@ + +Confirm deletion of mail class +@context_bar;noquote@ + + +

Confirm deletion of the mail class "@name@":

+

+

+
+ @export_vars;noquote@ + +
+
+ +
+
+
+ You can't delete this mail class "@name@" as long as there still are + pending mail jobs for this class. Please wait until they are processed. + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,17 @@ +ad_page_contract { +} { + class_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $class_id -privilege admin + +db_1row get_class_info {} + +set pending_jobs [db_string check_for_pending_jobs {}] + +set context_bar [list [list "." Administration] "Delete Mail Class"] +set export_vars [export_form_vars class_id] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-delete.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,27 @@ + + + + + + + select name + from ml_mail_classes + where mail_class_id = :class_id + and package_id = :package_id + + + + + + + + select count(*) + from ml_mail_jobs + where mail_class_id = :class_id + and state = 'pending' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,81 @@ + + + + oracle8.1.6 + + + + + begin + acs_permission.grant_permission ( + object_id => :class_id, + grantee_id => :the_public_id, + privilege => 'read' + ); + end; + + + + + + + + + begin + acs_permission.revoke_permission ( + object_id => :class_id, + grantee_id => :the_public_id, + privilege => 'read' + ); + end; + + + + + + + + + select acs_permission.permission_p(:class_id, oppm.party_id, :privilege) as permission_p, + oppm.party_id + from acs_object_party_privilege_map oppm + where oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and oppm.party_id <> :user_id + and acs_permission.permission_p(:package_id, oppm.party_id, 'admin') = 'f' + + + + + + + + + begin + acs_permission.grant_permission ( + object_id => :class_id, + grantee_id => :users_id, + privilege => :privilege + ); + end; + + + + + + + + + begin + acs_permission.revoke_permission ( + object_id => :class_id, + grantee_id => :users_id, + privilege => :privilege + ); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,65 @@ + + + + postgresql7.1 + + + + select acs_permission__grant_permission ( + :class_id, + :the_public_id, + 'read' + ); + + + + + + + select acs_permission__revoke_permission ( + :class_id, + :the_public_id, + 'read' + ); + + + + + + + + select acs_permission__permission_p(:class_id, oppm.party_id, :privilege) as permission_p, + oppm.party_id + from acs_object_party_privilege_map oppm + where oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and oppm.party_id <> :user_id + and acs_permission__permission_p(:package_id, oppm.party_id, 'admin') = 'f' + + + + + + + + select acs_permission__grant_permission ( + :class_id, + :users_id, + :privilege + ); + + + + + + + select acs_permission__revoke_permission ( + :class_id, + :users_id, + :privilege + ); + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,70 @@ +ad_page_contract { +} { + class_id:integer,notnull + public_p:optional + {users_read:multiple,optional ""} + {users_admin:multiple,optional ""} +} + +set package_id [ad_conn package_id] +set user_id [ad_conn user_id] + +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $class_id -privilege admin + +if {[exists_and_not_null public_p]} { + # toggle public_p + db_transaction { + db_dml update_public_p {} + + set the_public_id [acs_magic_object the_public] + if {$public_p == "t"} { + # grant all users read permissions -> public mail class + db_exec_plsql grant_user_class_read_privilege {} + } else { + # revoke read permission for all users -> private mail class + db_exec_plsql revoke_user_class_read_privilege {} + } + } +} else { + # set direct permissions + set add_users [list] + set remove_users [list] + if {![empty_string_p $users_read]} { + # we want to grant read permission to users + template::util::list_to_lookup $users_read admin_ids + set privilege read + } else { + # we want to grant admin permission to users + template::util::list_to_lookup $users_admin admin_ids + set privilege admin + } + + # get all users who've got the mailing_list_admin permission, + # but don't have the admin permission on the package + # (since you can't revoke the read/admin class permissions from them) + db_foreach get_all_mailing_list_admins {} { + if {$permission_p == "f" && [info exists admin_ids($party_id)]} { + # doesn't have the permission right now, but user wants him to + lappend add_users $party_id + } + if {$permission_p == "t" && ![info exists admin_ids($party_id)]} { + # does have the permission right now, but user doesn't want him to + lappend remove_users $party_id + } + } + + db_transaction { + # grant permission to users + foreach users_id $add_users { + db_exec_plsql grant_user_class_privilege {} + } + + # revoke permission from users + foreach users_id $remove_users { + db_exec_plsql revoke_user_class_privilege {} + } + } +} + +ad_returnredirect "class-permissions?[export_url_vars class_id]" Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-2.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,15 @@ + + + + + + + update ml_mail_classes + set public_p = :public_p + where mail_class_id = :class_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,23 @@ + + + + oracle8.1.6 + + + + + select p.person_id as admin_id, p.first_names, p.last_name, + acs_permission.permission_p(:class_id, p.person_id, 'admin') as admin_p, + acs_permission.permission_p(:class_id, p.person_id, 'read') as read_p, + acs_permission.permission_p(:package_id, p.person_id, 'admin') as package_admin_p + from acs_object_party_privilege_map oppm, persons p + where oppm.party_id = p.person_id + and oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and p.person_id <> :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,23 @@ + + + + postgresql7.1 + + + + + select p.person_id as admin_id, p.first_names, p.last_name, + acs_permission__permission_p(:class_id, p.person_id, 'admin') as admin_p, + acs_permission__permission_p(:class_id, p.person_id, 'read') as read_p, + acs_permission__permission_p(:package_id, p.person_id, 'admin') as package_admin_p + from acs_object_party_privilege_map oppm, persons p + where oppm.party_id = p.person_id + and oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and p.person_id <> :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,37 @@ + +Manage mail class permissions +@context_bar;noquote@ + + +

This mail class "@name@" is public. All other admins can use it.

+ Make private +
+ +

This mail class "@name@" is private. + + The following admins can use it:

+
+ @export_vars;noquote@ + + checked> @users_read.first_names@ @users_read.last_name@
+
+

+ +

+ + + + Make public + + + +

The following admins can edit/delete/use this mail class:

+
+ @export_vars;noquote@ + + checked> @users_admin.first_names@ @users_admin.last_name@
+
+

+ +

+ Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,31 @@ +ad_page_contract { +} { + class_id:integer,notnull +} + +set package_id [ad_conn package_id] +set user_id [ad_conn user_id] + +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $class_id -privilege admin + +db_1row get_class_info {} + +template::multirow create users_read user_id first_names last_name read_p +template::multirow create users_admin user_id first_names last_name admin_p + +db_foreach get_all_mailing_list_admins {} { + if {$package_admin_p == "f"} { + # you can't revoke the mailing_list_admin permission from package admins + # so it doesn't make sense to show them + if {$admin_p == "f"} { + template::multirow append users_read $admin_id $first_names $last_name $read_p + } + template::multirow append users_admin $admin_id $first_names $last_name $admin_p + } +} + +set context_bar [list [list "." Administration] "Mail Class Permissions"] +set export_vars [export_form_vars class_id] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/class-permissions.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + select name, public_p + from ml_mail_classes + where mail_class_id = :class_id + and package_id = :package_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/classes.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/classes.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/classes.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,7 @@ + +@action@ a Mail Class +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/classes.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/classes.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/classes.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,212 @@ +ad_page_contract { +} { + class_id:integer,optional + copy_class_id:integer,optional + mime_type:optional +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +if {[info exists class_id]} { + set action Edit +} else { + set action Add +} + +if {[info exists class_id] || [info exists copy_class_id]} { + if {[info exists copy_class_id]} { + set class_or_copy_id $copy_class_id + } else { + set class_or_copy_id $class_id + } + if {[db_0or1row get_old_class_mime_type {}]} { + set css_file [db_list_of_lists get_css_file {}] + } +} + +set context_bar [list [list "." Administration] "$action Mail Class"] + +set languages [db_list_of_lists get_ad_locales {}] + +ad_form -name mail_class_form -html {enctype multipart/form-data} -action classes -export {copy_class_id} -form { + {class_id:key} + {mime_type:text(hidden)} + {name:text {label "Name"} {html {size 50 maxlength 1000}}} + {locale:text(select) {label "Language"} {options $languages}} + {sender_email:text {label "Sender Email"} {html {size 80 maxlength 1000}}} + {subject:text {label "Default Subject"} {html {size 80 maxlength 1000}}} + {subject_change_p:text(radio) {label "Subject changeable?"} {options {{"Yes" t} {"No" f}}}} +} + +switch $mime_type { + "multipart/alternative" { + # alternative mail-class: plaintext and html + ad_form -extend -name mail_class_form -form { + {text_header:text(textarea),optional {label "Default Text Header"} {html {rows 5 cols 80}}} + {text_header_change_p:text(radio) {label "Text Header changeable?"} {options {{"Yes" t} {"No" f}}}} + {text_body:text(textarea),optional {label "Default Text Body"} {html {rows 5 cols 80}}} + {text_body_change_p:text(radio) {label "Text Body changeable?"} {options {{"Yes" t} {"No" f}}}} + {text_footer:text(textarea),optional {label "Default Text Footer"} {html {rows 5 cols 80}}} + {text_footer_change_p:text(radio) {label "Text Footer changeable?"} {options {{"Yes" t} {"No" f}}}} + {html_header:text(textarea),optional {label "Default HTML Header"} {html {rows 5 cols 80}}} + {html_header_change_p:text(radio) {label "HTML Header changeable?"} {options {{"Yes" t} {"No" f}}}} + {html_body:text(textarea),optional {label "Default HTML Body"} {html {rows 5 cols 80}}} + {html_body_change_p:text(radio) {label "HTML Body changeable?"} {options {{"Yes" t} {"No" f}}}} + {html_footer:text(textarea),optional {label "Default HTML Footer"} {html {rows 5 cols 80}}} + {html_footer_change_p:text(radio) {label "HTML Footer changeable?"} {options {{"Yes" t} {"No" f}}}} + {upload_file:file,optional {label "CSS-File"}} + } + } + "text/plain" { + # plaintext content mail-class + ad_form -extend -name mail_class_form -form { + {text_header:text(textarea),optional {label "Default Text Header"} {html {rows 5 cols 80}}} + {text_header_change_p:text(radio) {label "Text Header changeable?"} {options {{"Yes" t} {"No" f}}}} + {text_body:text(textarea),optional {label "Default Text Body"} {html {rows 5 cols 80}}} + {text_body_change_p:text(radio) {label "Text Body changeable?"} {options {{"Yes" t} {"No" f}}}} + {text_footer:text(textarea),optional {label "Default Text Footer"} {html {rows 5 cols 80}}} + {text_footer_change_p:text(radio) {label "Text Footer changeable?"} {options {{"Yes" t} {"No" f}}}} + {upload_file:file,optional {label "CSS-File"}} + } + } + "text/html" { + # html content mail-class + ad_form -extend -name mail_class_form -form { + {html_header:text(textarea),optional {label "Default HTML Header"} {html {rows 5 cols 80}}} + {html_header_change_p:text(radio) {label "HTML Header changeable?"} {options {{"Yes" t} {"No" f}}}} + {html_body:text(textarea),optional {label "Default HTML Body"} {html {rows 5 cols 80}}} + {html_body_change_p:text(radio) {label "HTML Body changeable?"} {options {{"Yes" t} {"No" f}}}} + {html_footer:text(textarea),optional {label "Default HTML Footer"} {html {rows 5 cols 80}}} + {html_footer_change_p:text(radio) {label "HTML Footer changeable?"} {options {{"Yes" t} {"No" f}}}} + {upload_file:file,optional {label "CSS-File"}} + } + } +} + +if {[exists_and_not_null css_file]} { + ad_form -extend -name mail_class_form -form { + {delete_css:integer(checkbox),optional {label "Delete CSS File"} {options $css_file}} + } +} + +ad_form -extend -name mail_class_form -form { + {comments:text(textarea),optional {label "Comments"} {html {rows 5 cols 80}}} +} -new_request { + if {[exists_and_not_null copy_class_id]} { + permission::require_permission -object_id $copy_class_id -privilege read + + db_1row get_copy_class_data {} + } else { + set name "" + set locale [ad_conn locale] + set sender_email "info@greenpeace.org" + set subject "" + set subject_change_p t + set text_header "" + set text_header_change_p t + set text_body "" + set text_body_change_p t + set text_footer "" + set text_footer_change_p t + set html_header "" + set html_header_change_p t + set html_body "" + set html_body_change_p t + set html_footer "" + set html_footer_change_p t + set comments "" + } +} -edit_request { + permission::require_permission -object_id $class_id -privilege admin + + db_1row get_class_data {} +} -on_submit { + if {$mime_type == "text/html"} { + set text_header "" + set text_header_change_p t + set text_body "" + set text_body_change_p t + set text_footer "" + set text_footer_change_p t + } + if {$mime_type == "text/plain"} { + set html_header "" + set html_header_change_p t + set html_body "" + set html_body_change_p t + set html_footer "" + set html_footer_change_p t + } +} -new_data { + set class_id [mail_class::add -name $name -locale $locale \ + -sender_email $sender_email -subject $subject \ + -subject_change_p $subject_change_p -text_header $text_header \ + -text_header_change_p $text_header_change_p -text_body $text_body \ + -text_body_change_p $text_body_change_p -text_footer $text_footer \ + -text_footer_change_p $text_footer_change_p -html_header $html_header \ + -html_header_change_p $html_header_change_p -html_body $html_body \ + -html_body_change_p $html_body_change_p -html_footer $html_footer \ + -html_footer_change_p $html_footer_change_p -mime_type $mime_type \ + -comments $comments] +} -edit_data { + permission::require_permission -object_id $class_id -privilege admin + + mail_class::edit -mail_class_id $class_id -name $name -locale $locale \ + -sender_email $sender_email -subject $subject -subject_change_p $subject_change_p \ + -text_header $text_header -text_header_change_p $text_header_change_p \ + -text_body $text_body -text_body_change_p $text_body_change_p \ + -text_footer $text_footer -text_footer_change_p $text_footer_change_p \ + -html_header $html_header -html_header_change_p $html_header_change_p \ + -html_body $html_body -html_body_change_p $html_body_change_p \ + -html_footer $html_footer -html_footer_change_p $html_footer_change_p \ + -mime_type $mime_type -comments $comments +} -after_submit { + db_transaction { + if {[info exists delete_css]} { + db_dml delete_css_file {} + } + if {![empty_string_p $upload_file]} { + set filename [lindex $upload_file 0] + set tmp_filename [lindex $upload_file 1] + set file_mimetype [lindex $upload_file 2] + set n_bytes [file size $tmp_filename] + set max_file_size [ad_parameter MaxAttachmentSize] + + if { $n_bytes > $max_file_size && $max_file_size > 0 } { + ad_return_complaint 1 "Your file is too large. The publisher of + [ad_system_name] has chosen to limit attachments to + [util_commify_number $max_file_size] bytes.\n" + } + if { $n_bytes == 0 } { + ad_return_complaint 1 "Your file is zero-length. Either you attempted to + upload a zero length file, a file which does not exists, + or something went wrong during the transfer.\n" + } + + if {[db_0or1row check_css_file_exists {}]} { + # there's already a css-file, so generate a new revision + cr_import_content -item_id $item_id -title $filename $class_id $tmp_filename $n_bytes $file_mimetype $filename + } else { + # generate new css-file + cr_import_content -title $filename $class_id $tmp_filename $n_bytes $file_mimetype $filename + } + ns_unlink $tmp_filename + db_dml make_latest_revision_live_revision {} + } + if {[info exists copy_class_id] && [empty_string_p $upload_file] && ![exists_and_not_null delete_css]} { + # copy css-file if no file uploaded + if {[db_0or1row get_file_data_for_copy {}]} { + # css-file exists in class to be copied from + set old_file "[cr_fs_path][cr_create_content_file_path $item_id $revision_id]" + set revision_id [cr_import_content -title $filename $class_id $old_file $content_length $file_mimetype $filename] + cr_set_imported_content_live $file_mimetype $revision_id + } + } + } + ad_returnredirect "." + ad_script_abort +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/classes.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/classes.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/classes.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,116 @@ + + + + + + + select mime_type + from ml_mail_classes + where mail_class_id = :class_or_copy_id + + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)', r.revision_id, + c.mime_type as old_mime_type + from cr_items i, cr_revisions r, ml_mail_classes c + where c.mail_class_id = :class_or_copy_id + and i.parent_id = c.mail_class_id + and r.revision_id = i.live_revision + + + + + + + + + select label as name, locale as value + from ad_locales + + + + + + + + + select name, locale, sender_email, subject, subject_change_p, + text_header, text_header_change_p, text_body, text_body_change_p, + text_footer, text_footer_change_p, html_header, html_header_change_p, + html_body, html_body_change_p, html_footer, html_footer_change_p, + mime_type, comments + from ml_mail_classes + where mail_class_id = :copy_class_id + + + + + + + + + select name, locale, sender_email, subject, subject_change_p, + text_header, text_header_change_p, text_body, text_body_change_p, + text_footer, text_footer_change_p, html_header, html_header_change_p, + html_body, html_body_change_p, html_footer, html_footer_change_p, + mime_type, comments + from ml_mail_classes + where mail_class_id = :class_id + + + + + + + + + update cr_items + set live_revision = null + where parent_id = :class_id + and live_revision = :delete_css + + + + + + + + + select item_id + from cr_items + where parent_id = :class_id + + + + + + + + + update cr_items + set live_revision = latest_revision + where parent_id = :class_id + + + + + + + + + select r.title as filename, r.content_length, r.mime_type as file_mimetype, + r.revision_id, i.item_id + from cr_revisions r, cr_items i + where i.parent_id = :copy_class_id + and r.revision_id = i.live_revision + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/index-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/index-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/index-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,56 @@ + + + + oracle8.1.6 + + + + + select l.list_id, l.name, nvl(su.user_count,0) as user_count, + nvl(uu.users_need_confirmation,0) as users_need_confirmation, + nvl(ue.users_need_email_confirmation,0) as users_need_email_confirmation, + (case when l.expiration_date > sysdate then 'f' else 't' end) as expired_p, + acs_permission.permission_p(l.list_id, :user_id, 'admin') as admin_p + from ml_mailing_lists l, + (select count(*) as user_count, m.list_id + from ml_mailing_list_user_map m + where m.subscribed_p = 't' + group by m.list_id) su, + (select count(*) as users_need_confirmation, + m2.list_id + from ml_mailing_list_user_map m2 + where m2.confirmed_p = 'f' + group by m2.list_id) uu, + (select count(*) as users_need_email_confirmation, + m2.list_id + from ml_mailing_list_user_map m2, users u + where m2.subscribed_p = 'f' + and m2.user_id = u.user_id + and u.email_verified_p = 'f' + group by m2.list_id) ue + where l.package_id = :package_id + and su.list_id(+) = l.list_id + and uu.list_id (+) = l.list_id + and ue.list_id (+) = l.list_id + and acs_permission.permission_p (l.list_id, :user_id, 'read') = 't' + order by lower(l.name) + + + + + + + + + select mail_class_id, name, + acs_permission.permission_p(mail_class_id, :user_id, 'admin') as admin_p + from ml_mail_classes + where package_id = :package_id + and acs_permission.permission_p (mail_class_id, :user_id, 'read') = 't' + order by lower(name) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/index-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/index-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/index-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,54 @@ + + + + postgresql7.1 + + + + select l.list_id, l.name, coalesce(su.user_count,0) as user_count, + coalesce(uu.users_need_confirmation,0) as users_need_confirmation, + coalesce(ue.users_need_email_confirmation,0) as users_need_email_confirmation, + (case when l.expiration_date > current_timestamp then 'f' else 't' end) as expired_p, + acs_permission__permission_p(l.list_id, :user_id, 'admin') as admin_p + from ml_mailing_lists l + left outer join (select count(*) as user_count, m.list_id + from ml_mailing_list_user_map m + where m.subscribed_p = 't' + group by m.list_id) su + on (su.list_id = l.list_id) + left outer join (select count(*) as users_need_confirmation, + m2.list_id + from ml_mailing_list_user_map m2 + where m2.confirmed_p = 'f' + group by m2.list_id) uu + on (uu.list_id = l.list_id) + left outer join (select count(*) as users_need_email_confirmation, + m2.list_id + from ml_mailing_list_user_map m2, users u + where m2.subscribed_p = 'f' + and m2.user_id = u.user_id + and u.email_verified_p = 'f' + group by m2.list_id) ue + on (ue.list_id = l.list_id) + where l.package_id = :package_id + and acs_permission__permission_p (l.list_id, :user_id, 'read') = 't' + order by lower(l.name) + + + + + + + + select mail_class_id, name, + acs_permission__permission_p(mail_class_id, :user_id, 'admin') as admin_p + from ml_mail_classes + where package_id = :package_id + and acs_permission__permission_p (mail_class_id, :user_id, 'read') = 't' + order by lower(name) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/index.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/index.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,76 @@ + +Mailing Lists Administration +@context_bar;noquote@ + +Administer Categories +
+Change Visible Categories +
+Change Country Category +
+Administer Country Codes +
+Administer Users Selections + + +

Mailing Lists

+ +
    + + +
  • @lists.name@ + (expired) + (@lists.user_count@ users subscribed, + @lists.users_need_confirmation@ users without confirmation, + @lists.users_need_email_confirmation@ users without + confirmed email) + (Delete + | Manage Permissions)
  • +
    + +
  • @lists.name@ + (@lists.user_count@ users subscribed, + @lists.users_need_confirmation@ users without confirmation)
  • +
    +
    +
    +
+ + + + +

Mail-Classes

+ + + + + +

Mail-Jobs

+ + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/index.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/index.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,23 @@ +ad_page_contract { +} -properties { + lists:multirow + classes:multirow + jobs:multirow +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +db_multirow lists ml_list {} { +# set user_count [expr $user_count - $users_need_confirmation] +} + +db_multirow classes ml_class {} + +set users_selection_url [mailing_list::util::get_sw_url -package_key users-selection] +set categories_url [mailing_list::util::get_sw_url -package_key categories] + +set context_bar [list Administration] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,40 @@ + + + + oracle8.1.6 + + + + + select mail_class_id, name + from ml_mail_classes + where acs_permission.permission_p(mail_class_id, :user_id, 'read') = 't' + + + + + + + + + select list_id, name + from ml_mailing_lists + where acs_permission.permission_p(list_id, :user_id, 'read') = 't' + and expiration_date > sysdate + + + + + + + + + select selection_id, title + from us_selections + where acs_permission.permission_p(selection_id, :user_id, 'read') = 't' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,40 @@ + + + + postgresql7.1 + + + + + select mail_class_id, name + from ml_mail_classes + where acs_permission__permission_p(mail_class_id, :user_id, 'read') = 't' + + + + + + + + + select list_id, name + from ml_mailing_lists + where acs_permission__permission_p(list_id, :user_id, 'read') = 't' + and expiration_date > current_timestamp + + + + + + + + + select selection_id, title + from us_selections + where acs_permission__permission_p(selection_id, :user_id, 'read') = 't' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,29 @@ + +New Mail Job +@context_bar;noquote@ + +

Please select the Mail Class of the new Mail Job

+

+

+ + +

Please select the Mailing List or the Users Selection of the new Mail Job

+

+ + OR + +

+ +

Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-add.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,17 @@ +ad_page_contract { +} { +} + +set package_id [ad_conn package_id] +set user_id [ad_conn user_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +db_multirow classes get_mail_classes {} + +db_multirow lists get_mailing_lists {} + +db_multirow queries get_users_selections {} + +set context_bar [list "Add Mail Job"] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,17 @@ + + + + oracle8.1.6 + + + + + begin + ml_mail_job.delete(:mail_job_id); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,13 @@ + + + + postgresql7.1 + + + + select ml_mail_job__delete(:mail_job_id); + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-2.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,12 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $mail_job_id -privilege admin + +db_exec_plsql delete_mail_job {} + +ad_returnredirect "." Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,18 @@ + + + + oracle8.1.6 + + + + + select to_char(scheduled_date, 'YYYY-MM-DD HH24:MI') as execution_date, + subject + from ml_mail_jobs + where mail_job_id=:mail_job_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,18 @@ + + + + postgresql7.1 + + + + + select to_char(scheduled_date, 'YYYY-MM-DD HH24:MI') as execution_date, + subject + from ml_mail_jobs + where mail_job_id=:mail_job_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,15 @@ + +Confirm deletion of mail job +@context_bar;noquote@ + +

Confirm deletion of the mail job "@subject@ (@execution_date@)":

+

+

+
+ @export_vars;noquote@ + +
+
+ +
+
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-delete.tcl 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,15 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $mail_job_id -privilege admin + +db_1row get_list_info {} + +set context_bar [list [list "." Administration] "Delete Mail Job"] +set export_vars [export_form_vars mail_job_id] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,28 @@ + + + + oracle8.1.6 + + + + + select j.subject, j.text_header, j.text_body, j.text_footer, j.html_header, + j.html_body, j.html_footer, j.mails_sent, j.mails_bounced, j.state, + j.track_links_p, p.first_names || ' ' || p.last_name as user_name, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date, + r.title as css_filename, r.content_length as css_file_length, + j.sender_email, c.name as class_name, j.template_p, j.mime_type, + j.selection_id, j.list_id + from ml_mail_jobs j, ml_mail_classes c, acs_objects o, persons p, + cr_revisions r + where j.mail_job_id = :mail_job_id + and c.mail_class_id = j.mail_class_id + and o.object_id = j.mail_job_id + and p.person_id = o.creation_user + and r.revision_id (+) = j.css_revision_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,30 @@ + + + + postgresql7.1 + + + + + select j.subject, j.text_header, j.text_body, j.text_footer, j.html_header, + j.html_body, j.html_footer, j.mails_sent, j.mails_bounced, j.state, + j.track_links_p, p.first_names || ' ' || p.last_name as user_name, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date, + r.title as css_filename, r.content_length as css_file_length, + j.sender_email, c.name as class_name, j.template_p, j.mime_type, + j.selection_id, j.list_id + from ml_mail_classes c + inner join ml_mail_jobs j using (mail_class_id) + inner join acs_objects o on + (o.object_id = j.mail_job_id) + inner join persons p on + (p.person_id = o.creation_user) + left outer join cr_revisions r on + (r.revision_id = j.css_revision_id) + where j.mail_job_id = :mail_job_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.adp 1 Oct 2003 05:01:54 -0000 1.1 @@ -0,0 +1,37 @@ + +Mail Job Detail +@context_bar;noquote@ + +

@subject@

+ +
+ @mails_sent@ mails sent on @execution_date@ (@mails_bounced@ bounced).

+ + From: @sender_email@

+ Subject: @subject@

+ To: @selection_name@ + @list_name@ + Deleted Mailing List or Users Selection +

+ + Text Body:

+ @text_body;noquote@ + + + HTML Body:

+ @html_body;noquote@ + + + +

Link Tracking + + + +

Attachments:

+
    + +
  • @attachments.filename@ (@attachments.file_length@ bytes)
  • +
    +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,72 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} -properties { +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $mail_job_id -privilege read + +db_1row get_job_data {} + +if {[exists_and_not_null selection_id]} { + db_1row get_selection_title {} + set selection_url "[mailing_list::util::get_sw_url -package_key users-selection]selection?[export_url_vars selection_id]" +} elseif {[exists_and_not_null list_id]} { + db_1row get_list_name {} + set list_url "lists?[export_url_vars list_id]" +} + +template::multirow create attachments filename file_length + +if {![empty_string_p $css_filename]} { + template::multirow append attachments $css_filename $css_file_length +} + +db_foreach get_mail_attachments {} { + template::multirow append attachments $filename $file_length +} + +set context_bar [list [list "." Administration] "Mail Job Detail"] + +if {![empty_string_p $text_body]} { + set text_body [ad_text_to_html -- "$text_header\n$text_body\n$text_footer"] +} +if {![empty_string_p $html_body]} { + set html_body "$html_header\n$html_body\n$html_footer" +} + +if {$template_p == "t" && [empty_string_p $selection_id]} { + # variable used in text, so try to substitute variables + set user_first_names "Joe" + set user_last_name "User" + set user_id 999 + set user_email "joe.user@hotmail.com" + + variable ::template::parse_level + lappend ::template::parse_level [info level] + # Now verify that the substitutions work + with_catch __errmsg { + if {![empty_string_p $text_body]} { + set __result [template::adp_compile -string $text_body] + template::adp_eval __result + set text_body $__adp_output + } + if {![empty_string_p $html_body]} { + set __result [template::adp_compile -string $html_body] + template::adp_eval __result + set html_body $__adp_output + } + set __result [template::adp_compile -string $subject] + template::adp_eval __result + set subject $__adp_output + } { + # substitution failed, so write error-text in mail_body + set text_body $__errmsg + } + template::util::lpop ::template::parse_level +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,31 @@ + + + + + + + select i.name as filename, r.content_length as file_length + from cr_items i, cr_revisions r + where i.parent_id = :mail_job_id + and r.item_id = i.item_id + + + + + + + select title as selection_name + from us_selections + where selection_id = :selection_id + + + + + + select name as list_name + from ml_mailing_lists + where list_id = :list_id + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,46 @@ + + + + oracle8.1.6 + + + + + select to_char(next_day(to_date(:start_date, 'YYYY-MM-DD'), 'sunday')-7, 'YYYY-MM-DD') as start_date, + to_char(next_day(to_date(:start_date, 'YYYY-MM-DD'), 'sunday')-1, 'YYYY-MM-DD') as end_date + from dual + + + + + + + + + select to_char(last_day(to_date(:start_date, 'YYYY-MM-DD')), 'YYYY-MM-DD') as end_date + from dual + + + + + + + + + select j.mail_job_id, j.mail_class_id, j.subject, j.mails_sent, j.state, + j.track_links_p, p.first_names || ' ' || p.last_name as user_name, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date + from ml_mail_jobs j, acs_objects o, persons p + where j.state <> 'suspended' + and j.scheduled_date >= to_date(:start_date, 'YYYY-MM-DD') + and j.scheduled_date < to_date(:end_date, 'YYYY-MM-DD') + 1 + and acs_permission.permission_p(j.mail_job_id, :user_id, 'read') = 't' + and o.object_id = j.mail_job_id + and p.person_id = o.creation_user + order by j.execution_date desc, lower(j.subject) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,47 @@ + + + + postgresql7.1 + + + + + select to_char(next_day(to_date(:start_date, 'YYYY-MM-DD'), + 'sunday')-(cast ('7 days' as interval)), 'YYYY-MM-DD') as start_date, + to_char(next_day(to_date(:start_date, 'YYYY-MM-DD'), + 'sunday')-(cast ('1 day' as interval)), 'YYYY-MM-DD') as end_date + + + + + + + + + + select to_char(to_date(to_date(:start_date,'YYYY-MM') + '1 month'::interval - '1 day'::interval , 'YYYY-MM-DD'), 'YYYY-MM-DD') as end_date + + + + + + + + + select j.mail_job_id, j.mail_class_id, j.subject, j.mails_sent, j.state, + j.track_links_p, p.first_names || ' ' || p.last_name as user_name, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date + from ml_mail_jobs j, acs_objects o, persons p + where j.state <> 'suspended' + and j.scheduled_date >= to_timestamp(:start_date, 'YYYY-MM-DD') + and j.scheduled_date < (to_timestamp(:end_date, 'YYYY-MM-DD') + '1 day'::interval) + and acs_permission__permission_p(j.mail_job_id, :user_id, 'read') = 't' + and o.object_id = j.mail_job_id + and p.person_id = o.creation_user + order by j.execution_date desc, lower(j.subject) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,31 @@ + +Mail Job History +@context_bar;noquote@ + + + + +
+ +

Mails @start_date@ to @end_date@

+    +
+
   + @date_widget;noquote@ +
+ + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,51 @@ +ad_page_contract { +} { + from_date:array,optional + to_date:array,optional + {view day} + {date ""} +} -properties { + jobs:multirow + date_widget:onerow + start_date:onerow + end_date:onerow +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +if {[empty_string_p $date]} { + set date [join [util::date::get_property linear_date_no_time [util::date::now]] -] + if {[info exists from_date]} { + set start_date "$from_date(year)-$from_date(month)-$from_date(day)" + } + if {[info exists to_date]} { + set end_date "$to_date(year)-$to_date(month)-$to_date(day)" + } +} else { + switch $view { + day - list { + set start_date $date + set end_date $date + } + week { + set start_date $date + db_1row get_week_dates {} + } + month { + set year [lindex [split $date -] 0] + set month [lindex [split $date -] 1] + set start_date "$year-$month-01" + db_1row get_end_of_month {} + } + } +} + +db_multirow jobs ml_mail_job_history {} + +set context_bar [list [list "." Administration] [list job-history "Mail Job History"] "Show"] + +set date_widget [dt_widget_calendar_navigation job-history-2 $view $date] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,8 @@ + +Mail Job History +@context_bar;noquote@ + +

Select Dates to display Mail Job History

+
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,19 @@ +ad_page_contract { +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set format "YYYY-MM-DD" +set from_date [util::date::now] +set to_date [util::date::now] + +set context_bar [list [list "." Administration] "Mail Job History"] + +ad_form -name job_history_form -action job-history-2 -form { + {from_date:date,to_sql(sql_date) {label "From"} {format $format} {value $from_date} {help}} + {to_date:date,to_sql(sql_date) {label "To"} {format $format} {value $to_date} {help}} +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,22 @@ + + + + oracle8.1.6 + + + + + select j.mail_job_id, j.mail_class_id, j.subject, j.state, + to_char(j.scheduled_date, 'YYYY-MM-DD HH24:MI') as execution_date + from ml_mail_jobs j, acs_named_objects o + where o.package_id = :package_id + and o.object_id = j.mail_job_id + and j.state in ('suspended', 'active') + and acs_permission.permission_p(j.mail_job_id, :user_id, 'admin') = 't' + order by j.scheduled_date, lower(subject) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,22 @@ + + + + postgresql7.1 + + + + + select j.mail_job_id, j.mail_class_id, j.subject, j.state, + to_char(j.scheduled_date, 'YYYY-MM-DD HH24:MI') as execution_date + from ml_mail_jobs j, acs_named_objects o + where o.package_id = :package_id + and o.object_id = j.mail_job_id + and j.state in ('suspended', 'active') + and acs_permission__permission_p(j.mail_job_id, :user_id, 'admin') = 't' + order by j.scheduled_date, lower(subject) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,19 @@ + +Pending Mail Jobs +@context_bar;noquote@ + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,14 @@ +ad_page_contract { +} -properties { + jobs:multirow +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +db_multirow jobs ml_suspended_mail_jobs {} + +set context_bar [list [list "." Administration] "Pending Mail Jobs"] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,49 @@ + +Mail Job Preview +@context_bar;noquote@ + +
+ Scheduled Date: @scheduled_date@

+ + From: @sender_email@

+ To: @selection_name@ + @list_name@ + Deleted Mailing List or Users Selection

+ Subject: @mail_subject@

+ + Text Body:

+ @mail_text_body;noquote@ +

+ + + HTML Body:

+ @mail_html_body;noquote@ +

+ + + +

Attachments:

+
    + +
  • @attachments.name@
  • +
    +
+ + + +

Error! It is not allowed to use inline-tcl code in the mail!

+
+ + +

Error! The following variables are not supported:

+
    + +
  • \@@var_errors.var@\@
  • +
    +
+
+
+ + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,173 @@ +ad_page_contract { + {mail_job_id:integer,notnull} + {bind_var:array,optional} +} { +} + +permission::require_permission -object_id $class_id -privilege read +if {[exists_and_not_null list_id]} { + db_1row get_list_name {} + set list_url "lists?[export_url_vars list_id]" + permission::require_permission -object_id $list_id -privilege read +} else { + db_1row get_selection_title {} + set selection_url "[mailing_list::util::get_sw_url -package_key users-selection]selection?[export_url_vars selection_id]" + permission::require_permission -object_id $selection_id -privilege read +} + +set context_bar [list [list "." Administration] "Preview Mail Job"] + +db_1row get_default_data {} + +if {![info exists text_body]} { + set text_header "" + set text_body "" + set text_footer "" +} +if {![info exists html_body]} { + set html_header "" + set html_body "" + set html_footer "" +} + +if {$subject_change_p == "f"} { + set subject $default_subject +} +if {$text_header_change_p == "f"} { + set text_header $default_text_header +} +if {$text_body_change_p == "f"} { + set text_body $default_text_body +} +if {$text_footer_change_p == "f"} { + set text_footer $default_text_footer +} +if {$html_header_change_p == "f"} { + set html_header $default_html_header +} +if {$html_body_change_p == "f"} { + set html_body $default_html_body +} +if {$html_footer_change_p == "f"} { + set html_footer $default_html_footer +} + +set mail_subject $subject +if {![empty_string_p $text_body]} { + set mail_text_body [ad_text_to_html -- "$text_header\n$text_body\n$text_footer"] +} else { + set mail_text_body "" +} + +if {![empty_string_p $html_body]} { + set mail_html_body "$html_header\n$html_body\n$html_footer" +} else { + set mail_html_body "" +} + +set tcl_code_p [mailing_list::util::text_contains_tcl_code -text "$subject $text_header $text_body $text_footer $html_header $html_body $html_footer"] + +template::multirow create attachments name + +if {![db_0or1row get_old_css_file {}]} { + db_0or1row get_current_css_file {} +} + +if {[info exists css_file]} { + template::multirow append attachments $css_file +} + +db_foreach get_attachments {} { + template::multirow append attachments $file_name +} + +if {[regexp [template::adp_variable_regexp] "$subject $mail_text_body $mail_html_body"] || [regexp [template::adp_variable_regexp_noquote] $mail_html_body]} { + set template_p 1 +} else { + set template_p 0 +} + +set form [ns_getform] +for { set i 0 } { $i < [ns_set size $form] } { incr i } { + if {[regexp {bind_var\.(.*)} [ns_set key $form $i] match var_name]} { + set bind_var($var_name) [ns_set value $form $i] + } +} + +template::multirow create var_errors var + +if {$template_p} { + # check if all used variables are valid + set check_text "$subject $mail_text_body $mail_html_body" + # strip out all noquotes + while {[regsub -all [template::adp_variable_regexp_noquote] $check_text {\1@\2@} check_text]} {} + + # get list of all valid vars + if {[exists_and_not_null list_id]} { + # get all valid variables for mailing lists + set valid_vars [list user_id user_first_names user_last_name user_email] + } else { + # get sql-query + if {![db_0or1row get_mail_job_sql_query {}]} { + db_1row get_users_selection_query {} + } + # resolve sql-query if bind vars are used + if {[info exists bind_var]} { + set sql_query [db_bind_var_substitution $sql_query [array get bind_var]] + } + # get query columns - these are the variables names + # the user is allowed to use + set valid_vars [user_selection::get_field_names -query $sql_query] + } + + # check text if all used variables are valid + set invalid_vars [mailing_list::util::check_valid_vars -text $check_text -valid_vars $valid_vars] + + # generate error messages for each invalid variable + foreach invalid_var $invalid_vars { + template::multirow append var_errors $invalid_var + } +} + +if {$template_p && [exists_and_not_null list_id] && [empty_string_p $invalid_vars]} { + # variable found in text, so try to substitute variables + + set mail_subject $subject + # we have to use noquote-substitution for mail subject + while {[regsub -all [template::adp_variable_regexp] $mail_subject {\1@\2;noquote@} mail_subject]} {} + if {![empty_string_p $mail_text_body]} { + # we have to use noquote-substitution for plaintext emails + while {[regsub -all [template::adp_variable_regexp] $mail_text_body {\1@\2;noquote@} mail_text_body]} {} + } + + set user_first_names "Joe" + set user_last_name "User" + set user_id 999 + set user_email "joe.user@hotmail.com" + + variable ::template::parse_level + lappend ::template::parse_level [info level] + # Now verify that the substitutions work + with_catch __errmsg { + if {![empty_string_p $mail_text_body]} { + set __result [template::adp_compile -string $mail_text_body] + template::adp_eval __result + set mail_text_body $__adp_output + } + if {![empty_string_p $mail_html_body]} { + set __result [template::adp_compile -string $mail_html_body] + template::adp_eval __result + set mail_html_body $__adp_output + } + set __result [template::adp_compile -string $subject] + template::adp_eval __result + set mail_subject $__adp_output + } { + # substitution failed, so write error-text in mail_body + set mail_subject $subject + set mail_text_body $__errmsg + } + template::util::lpop ::template::parse_level +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,94 @@ + + + + + + + select subject_change_p, text_header_change_p, text_body_change_p, + text_footer_change_p, html_header_change_p, html_body_change_p, + html_footer_change_p, subject as default_subject, + text_header as default_text_header, text_body as default_text_body, + text_footer as default_text_footer, html_header as default_html_header, + html_body as default_html_body, html_footer as default_html_footer + from ml_mail_classes + where mail_class_id = :class_id + + + + + + + select title as selection_name + from us_selections + where selection_id = :selection_id + + + + + + select name as list_name + from ml_mailing_lists + where list_id = :list_id + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)' as css_file + from cr_revisions r, ml_mail_jobs j + where r.revision_id = j.css_revision_id + and j.mail_job_id = :mail_job_id + + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)' as css_file + from cr_revisions r, cr_items i + where r.revision_id = i.live_revision + and i.parent_id = :class_id + + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)' as file_name + from cr_items i, cr_revisions r + where i.parent_id = :mail_job_id + and r.revision_id = i.latest_revision + + + + + + + + + select sql_query + from ml_mail_jobs + where mail_job_id = :mail_job_id + + + + + + + + + select full_sql as sql_query + from us_selections + where selection_id = :selection_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,13 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $mail_job_id -privilege admin + +db_dml resume_mail_job {} + +ad_returnredirect "job-pending" Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-resume.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + update ml_mail_jobs + set state = 'active' + where mail_job_id = :mail_job_id + and state = 'suspended' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,13 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $mail_job_id -privilege admin + +db_dml suspend_mail_job {} + +ad_returnredirect "job-pending" Index: openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-suspend.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + update ml_mail_jobs + set state = 'suspended' + where mail_job_id = :mail_job_id + and state = 'active' + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,39 @@ + + + + oracle8.1.6 + + + + + select j.locale, j.sender_email, j.track_links_p, j.subject, + j.text_header, j.text_body, j.text_footer, j.html_header, + j.html_body, j.html_footer, j.mime_type, j.state, + to_char(j.scheduled_date, :format) as scheduled_date, + c.name as class_name, c.comments as class_comment, + m.name as list_name, m.comments as list_comment, + s.title as selection_name, s.description as selection_desc + from ml_mail_jobs j, ml_mail_classes c, ml_mailing_lists m, + us_selections s + where j.mail_job_id = :mail_job_id + and j.list_id = m.list_id (+) + and m.package_id (+) = :package_id + and j.selection_id = s.selection_id (+) + and c.mail_class_id = j.mail_class_id + + + + + + + + + begin + content_item.delete(:file_id); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,33 @@ + + + + postgresql7.1 + + + + select j.locale, j.sender_email, j.track_links_p, j.subject, + j.text_header, j.text_body, j.text_footer, j.html_header, + j.html_body, j.html_footer, j.mime_type, j.state, + to_char(j.scheduled_date, :format) as scheduled_date, + c.name as class_name, c.comments as class_comment, + m.name as list_name, m.comments as list_comment, + s.title as selection_name, s.description as selection_desc + from ml_mail_jobs j + inner join ml_mail_classes c using (mail_class_id) + left outer join ml_mailing_lists m + on (j.list_id = m.list_id and m.package_id = :package_id) + left outer join us_selections s + on (j.selection_id = s.selection_id) + where j.mail_job_id = :mail_job_id + + + + + + + select content_item__delete(:file_id); + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,7 @@ + +@action@ a Mail Job +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,434 @@ +ad_page_contract { +} { + mail_job_id:integer,optional + class_id:integer + {list_id:integer,optional ""} + {selection_id:integer,optional ""} + delete_files:optional,multiple + bind_var:array,optional +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $class_id -privilege read +if {[exists_and_not_null list_id]} { + permission::require_permission -object_id $list_id -privilege read +} +if {[exists_and_not_null selection_id]} { + permission::require_permission -object_id $selection_id -privilege read + db_1row get_users_selection_query {} +} + +set format "YYYY-MM-DD HH24:MI" + +if {[info exists mail_job_id]} { + db_1row check_if_job_exists {} +} else { + set edit_job_p 0 +} + + +if {$edit_job_p} { + set action Edit + set attachments [db_list_of_lists get_attachments {}] + db_0or1row get_old_css_file {} + db_0or1row get_old_list_or_users_selection {} +} else { + set action Add + set attachments "" + db_0or1row get_current_css_file {} +} + + +set context_bar [list [list "." Administration] "$action Mail Job"] + +set languages [db_list_of_lists get_ad_locales {}] + +db_1row check_if_data_changeable {} + +if {$mime_type == "text/plain"} { + set default_html_header "" + set default_html_body "" + set default_html_footer "" + set html_header_change_p f + set html_body_change_p f + set html_footer_change_p f +} + +if {$mime_type == "text/html"} { + set default_text_header "" + set default_text_body "" + set default_text_footer "" + set text_header_change_p f + set text_body_change_p f + set text_footer_change_p f +} + +ad_form -name mail_job_form -html {enctype multipart/form-data} -form { + {mail_job_id:key} + {class_id:text(hidden)} + {class_name:text(inform) {label "Mail Class"}} +} + +if {[exists_and_not_null list_id]} { + # spamming a mailing list + ad_form -extend -name mail_job_form -form { + {list_id:text(hidden)} + {list_name:text(inform) {label "Mailing List"}} + } + set allowed_variables [list user_id user_first_names user_last_name user_email] +} else { + # spamming an user-selection + ad_form -extend -name mail_job_form -form { + {selection_id:text(hidden)} + {selection_name:text(inform) {label "Users Selection"}} + } + + if {$edit_job_p} { + set bind_vars_values [db_list_of_lists get_mail_job_bind_vars {}] + } else { + set bind_vars_values [db_list_of_lists get_selection_bind_vars {}] + } + + # add form entry for each query bind variable + set ad_form_code "-form \{\n" + set subs_list "" + foreach bind_value $bind_vars_values { + util_unlist $bind_value var_name var_description var_value + lappend subs_list $var_name $var_value + append ad_form_code "\{bind_var.$var_name:text \{label \"$var_description\"\} \{value \"$var_value\"\}\}\n" + } + append ad_form_code "\}" + eval ad_form -extend -name mail_job_form $ad_form_code + + if {![empty_string_p $subs_list]} { + set query_string [db_bind_var_substitution $query_string $subs_list] + } + set allowed_variables [user_selection::get_field_names -query $query_string] +} + +ad_form -extend -name mail_job_form -form { + {locale:text(select) {label "Language"} {options $languages}} + {sender_email:text {label "Sender Email"} {html {size 80 maxlength 1000}}} +} + +set pretty_allowed_vars "@[join $allowed_variables "@, @"]@" +ad_form -extend -name mail_job_form -form { + {zz:text(inform) {label " "} {value "You are allowed to use the following variables in the mail text: $pretty_allowed_vars"}} +} + +if {$subject_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {subject:text {label "Subject"} {html {size 80 maxlength 1000}}} + } +} else { + ad_form -extend -name mail_job_form -form { + {subject:text(inform) {label "Subject"}} + } +} + +if {$mime_type != "text/html"} { + if {$text_header_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {text_header:text(textarea),optional {label "Text Header"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {text_header:text(inform),optional {label "Text Header"}} + } + } + + if {$text_body_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {text_body:text(textarea) {label "Text Body"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {text_body:text(inform) {label "Text Body"}} + } + } + + if {$text_footer_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {text_footer:text(textarea),optional {label "Text Footer"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {text_footer:text(inform),optional {label "Text Footer"}} + } + } +} + +if {$mime_type != "text/plain"} { + if {$html_header_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {html_header:text(textarea),optional {label "HTML Header"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {html_header:text(inform),optional {label "HTML Header"}} + } + } + + if {$html_body_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {html_body:text(textarea) {label "HTML Body"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {html_body:text(inform) {label "HTML Body"}} + } + } + + if {$html_footer_change_p == "t"} { + ad_form -extend -name mail_job_form -form { + {html_footer:text(textarea),optional {label "HTML Footer"} {html {rows 5 cols 80}}} + } + } else { + ad_form -extend -name mail_job_form -form { + {html_footer:text(inform),optional {label "HTML Footer"}} + } + } +} + +if {[exists_and_not_null css_file]} { + ad_form -extend -name mail_job_form -form { + {css_file:text(inform) {label "CSS-File"}} + } +} + +if {[exists_and_not_null attachments]} { + ad_form -extend -name mail_job_form -form { + {delete_files:integer(checkbox),multiple,optional {label "Delete Attachments"} {options $attachments}} + } +} + +set ad_form_code { -form { + {upload_file:file,optional {label "Attachment"}} + {xx:text(inform) {label " "} {value "You can attach as many files as you want"}} + {track_links_p:text(radio) {label "Track Links?"} {options {{"Yes" t} {"No" f}}}} + {state:text(radio) {label "Status"} {options {{"Active" active} {"Suspended" suspended}}}} + {yy:text(inform) {label " "} {value "Don't forget to activate after uploading all attachments"}} + {scheduled_date:date,to_sql(sql_date),to_html(display_date) {label "Execution Date"} {format $format} {help}} +} -new_request { + if {![db_0or1row get_mail_class_data {}]} { + ad_return_complaint 1 "This mail class has been deleted." + return + } + + if {![empty_string_p $class_comment]} { + set class_name "$class_name ($class_comment)" + } + if {![empty_string_p $list_id]} { + db_1row get_list_name {} + + if {![empty_string_p $list_comment]} { + set list_name "$list_name ($list_comment)" + } + } + if {![empty_string_p $selection_id]} { + db_1row get_users_selection_name {} + + if {![empty_string_p $selection_desc]} { + set selection_name "$selection_name ($selection_desc)" + } + } + + set track_links_p t + set state active + set scheduled_date [util::date::now] + + if {$subject_change_p == "f"} { + set subject [ad_quotehtml $subject] + } + if {$text_header_change_p == "f"} { + set text_header [ad_quotehtml $text_header] + } + if {$text_body_change_p == "f"} { + set text_body [ad_quotehtml $text_body] + } + if {$text_footer_change_p == "f"} { + set text_footer [ad_quotehtml $text_footer] + } + if {$html_header_change_p == "f"} { + set html_header [ad_quotehtml $html_header] + } + if {$html_body_change_p == "f"} { + set html_body [ad_quotehtml $html_body] + } + if {$html_footer_change_p == "f"} { + set html_footer [ad_quotehtml $html_footer] + } +} -edit_request { + permission::require_permission -object_id $mail_job_id -privilege admin + + if {![db_0or1row get_mail_job_data {}]} { + ad_return_complaint 1 "This mail job has been deleted." + return + } + + set scheduled_date [util::date::acquire clock [clock scan $scheduled_date]] + + if {![empty_string_p $class_comment]} { + set class_name "$class_name ($class_comment)" + } + if {![empty_string_p $list_comment]} { + set list_name "$list_name ($list_comment)" + } + if {![empty_string_p $selection_desc]} { + set selection_name "$selection_name ($selection_desc)" + } + if {$subject_change_p == "f"} { + set subject [ad_quotehtml $subject] + } + if {$text_header_change_p == "f"} { + set text_header [ad_quotehtml $text_header] + } + if {$text_body_change_p == "f"} { + set text_body [ad_quotehtml $text_body] + } + if {$text_footer_change_p == "f"} { + set text_footer [ad_quotehtml $text_footer] + } + if {$html_header_change_p == "f"} { + set html_header [ad_quotehtml $html_header] + } + if {$html_body_change_p == "f"} { + set html_body [ad_quotehtml $html_body] + } + if {$html_footer_change_p == "f"} { + set html_footer [ad_quotehtml $html_footer] + } +} -on_submit { + permission::require_permission -object_id $class_id -privilege read + if {[exists_and_not_null list_id]} { + permission::require_permission -object_id $list_id -privilege read + } else { + permission::require_permission -object_id $selection_id -privilege read + } + + if {![empty_string_p $upload_file]} { + # if user uploaded a file, let him upload some more + # and in the meantime mark created job as suspended + set state "suspended" + } + if {$subject_change_p == "f"} { + set subject $default_subject + } + if {$text_header_change_p == "f"} { + set text_header $default_text_header + } + if {$text_body_change_p == "f"} { + set text_body $default_text_body + } + if {$text_footer_change_p == "f"} { + set text_footer $default_text_footer + } + if {$html_header_change_p == "f"} { + set html_header $default_html_header + } + if {$html_body_change_p == "f"} { + set html_body $default_html_body + } + if {$html_footer_change_p == "f"} { + set html_footer $default_html_footer + } + + if {[mailing_list::util::text_contains_tcl_code -text "$subject $text_header $text_body $text_footer $html_header $html_body $html_footer"]} { + ad_return_error "Mail Text contains inline tcl-code" "It is not permitted to use inline tcl code in emails" + return + } + + if {[regexp [template::adp_variable_regexp] "$subject $text_header $text_body $text_footer $html_header $html_body $html_footer"] || [regexp [template::adp_variable_regexp_noquote] "$html_header $html_body $html_footer"]} { + # variable found in text, so enable variable substitution when + # sending email + set template_p t + } else { + # no variable found, so don't try to substitute variables when + # sending email (faster) + set template_p f + } + if {[info exists bind_var]} { + set bind_vars [array get bind_var] + } else { + set bind_vars "" + } +} -new_data { + set mail_job_id [mail_job::add -class_id $class_id -list_id $list_id \ + -selection_id $selection_id -locale $locale \ + -sender_email $sender_email -track_links_p $track_links_p \ + -subject $subject -text_header $text_header -text_body $text_body \ + -text_footer $text_footer -html_header $html_header \ + -html_body $html_body -html_footer $html_footer \ + -mime_type $mime_type -template_p $template_p -state $state \ + -scheduled_date $scheduled_date -bind_vars $bind_vars] +} -edit_data { + permission::require_permission -object_id $mail_job_id -privilege admin + + mail_job::edit -mail_job_id $mail_job_id -locale $locale -sender_email $sender_email \ + -track_links_p $track_links_p -subject $subject -text_header $text_header \ + -text_body $text_body -text_footer $text_footer -html_header $html_header \ + -html_body $html_body -html_footer $html_footer -mime_type $mime_type \ + -template_p $template_p -state $state -scheduled_date $scheduled_date \ + -bind_vars $bind_vars +} -after_submit { + db_transaction { + if {[info exists bind_var]} { + foreach var_name [array names bin_var] { + set value $bind_var($var_name) + db_dml update_bind_var {} + } + } + set target_url "." + if {![empty_string_p $upload_file]} { + set filename [lindex $upload_file 0] + set tmp_filename [lindex $upload_file 1] + set file_mimetype [lindex $upload_file 2] + set n_bytes [file size $tmp_filename] + set max_file_size [ad_parameter MaxAttachmentSize] + + if { $n_bytes > $max_file_size && $max_file_size > 0 } { + ad_return_complaint 1 "Your file is too large. The publisher of + [ad_system_name] has chosen to limit attachments to + [util_commify_number $max_file_size] bytes.\n" + return + } + if { $n_bytes == 0 } { + ad_return_complaint 1 "Your file is zero-length. Either you attempted to + upload a zero length file, a file which does not exists, + or something went wrong during the transfer.\n" + return + } + cr_import_content -title $filename $mail_job_id $tmp_filename $n_bytes $file_mimetype $filename + set target_url "jobs?[export_url_vars mail_job_id class_id]" + } + if {[info exists delete_files]} { + foreach file_id $delete_files { + db_exec_plsql delete_file {} + + set path "[cr_fs_path][cr_create_content_file_path $file_id ""]" + foreach revision [glob -directory $path "*"] { + ns_unlink $revision + } + ns_rmdir $path + } + } + } + + ad_returnredirect $target_url + ad_script_abort +}} + +set preview_switch "-confirm_template job-preview" + +array set formvars [util_ns_set_to_list -set [ns_getform]] +if {[info exists formvars(upload_file)] && [llength $formvars(upload_file)] > 0} { + # show the same form if user uploads several files + # only show confirmation page if user didn't upload another file + set preview_switch "" +} + +eval ad_form -extend -name mail_job_form $preview_switch -action jobs $ad_form_code + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,171 @@ + + + + + + + select full_sql as query_string + from us_selections + where selection_id = :selection_id + + + + + + + + + select count(*) as edit_job_p + from ml_mail_jobs + where mail_job_id = :mail_job_id + + + + + + + + + select i.name || ' (' || r.content_length || ' bytes)' as name, + i.item_id as value + from cr_items i, cr_revisions r + where i.parent_id = :mail_job_id + and r.item_id = i.item_id + + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)' as css_file + from cr_revisions r, ml_mail_jobs j + where r.revision_id = j.css_revision_id + and j.mail_job_id = :mail_job_id + + + + + + + + + select list_id, selection_id + from ml_mail_jobs m + where mail_job_id = :mail_job_id + + + + + + + + + select r.title || ' (' || r.content_length || ' bytes)' as css_file + from cr_revisions r, cr_items i + where r.revision_id = i.live_revision + and i.parent_id = :class_id + + + + + + + + + select label as name, locale as value + from ad_locales + + + + + + + + + select subject_change_p, text_header_change_p, text_body_change_p, + text_footer_change_p, html_header_change_p, html_body_change_p, + html_footer_change_p, subject as default_subject, mime_type, + text_header as default_text_header, text_body as default_text_body, + text_footer as default_text_footer, html_header as default_html_header, + html_body as default_html_body, html_footer as default_html_footer + from ml_mail_classes + where mail_class_id = :class_id + + + + + + + + + select name, description, value + from ml_mail_job_bind_vars + where mail_job_id = :mail_job_id + order by name + + + + + + + + + select name, description, default_value + from us_bind_vars + where selection_id = :selection_id + order by name + + + + + + + + + select c.locale, c.sender_email, c.subject, c.text_header, c.text_body, + c.text_footer, c.html_header, c.html_body, c.html_footer, + c.mime_type, c.name as class_name, c.comments as class_comment + from ml_mail_classes c + where c.mail_class_id = :class_id + + + + + + + + + select name as list_name, comments as list_comment + from ml_mailing_lists + where list_id = :list_id + + + + + + + + + select title as selection_name, description as selection_desc + from us_selections + where selection_id = :selection_id + + + + + + + + + update ml_mail_job_bind_vars + set value = :value + where mail_job_id = :mail_job_id + and name = :var_name + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,23 @@ + + + + oracle8.1.6 + + + + + select count(*) as number_clicks, trunc(l.click_time) as day, + p.category_id + from mail_link_clicks l, category_object_map cm, categories c, categories p + where l.link_id = :link_id + and cm.object_id = l.user_id + and cm.category_id = c.category_id + and c.tree_id = :tree_id + and c.parent_id = p.category_id + group by trunc(l.click_time), p.category_id + order by p.category_id, trunc(l.click_time) + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,24 @@ + + + + postgresql7.1 + + + + + select count(*) as number_clicks, to_char(l.click_time,'YYYY-MM-DD') as day, + p.category_id + from mail_link_clicks l, category_object_map cm, categories c, categories p + where l.link_id = :link_id + and cm.object_id = l.user_id + and cm.category_id = c.category_id + and c.tree_id = :tree_id + and c.parent_id = p.category_id + group by day, p.category_id + order by p.category_id, day + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,22 @@ + +Detailed Link Clicks +@context_bar;noquote@ + +@link_url@ +

Link Clicks

+ + +

+ +

+
+ + @clicks.region@: +

+ + + +
Day# Clicks
@clicks.day@@clicks.number_clicks@

+ +
+ Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,67 @@ +ad_page_contract { + Show hourly link clicks + + @cvs-id $Id: link-detail.tcl,v 1.1 2003/10/01 05:01:55 maltes Exp $ +} { + link_id:integer,notnull + mail_job_id:integer,notnull +} -properties { + context_bar:onevalue + link_url:onevalue + clicks:multirow +} + +set package_id [ad_conn package_id] +set context_bar [list [list "." Administration] [list job-history "Mail Job History"] [list "link-track?[export_url_vars mail_job_id]" "Link Tracking"] "Daily Registrations"] + +if {![db_0or1row get_current_country_category_tree {}]} { + # no country tree mapped, so return to index page immediately + ad_returnredirect "." + return +} + +template::multirow create clicks category_id region day number_clicks + +# get number of link clicks each hour +# split this number by regions + + +######### Charts code ###################### + set regions [list] +# A list of labels + set regions_value [list] +# A list that stores the values for a lable + set image_name "dayli_clicks" +########################################### + + +db_foreach get_link_clicks {} { + template::multirow append clicks $category_id [category::get_name $category_id] $day $number_clicks + + ############charts code########## + lappend regions "[category::get_name $category_id]" + lappend regions_value "$number_clicks" + ################################## +} + + +#############charts code########## +# Data preperation +set values [list] +lappend values $regions +lappend values $regions_value + +# Image creation +set image_name "clicks_$tree_id" +set dummy [tgdchart::3dbar -title "To Days Clicks" -ytitle "Clicks" -xtitle "Regions" -file "$image_name" -values "$values" -xsize 300 -ysize 400] + +set image_file "/tgdcharts/$package_id/$image_name.png" +# The file argument will properly change till the end of development. +# The function will then return the full path to the Image. +# right now it's always "/tgdcharts/$image_name.png" +# In the final version the function should return a file argument like this. +# "/tgdcharts/creation-package-id/$image_name.png" +# so each oacs package has it's own namespace. +##################################### + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-detail.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + + + + + + + select t.tree_id, l.url as link_url + from ml_country_category_tree t, mail_links l + where t.package_id = :package_id + and l.link_id = :link_id + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,21 @@ + + + + oracle8.1.6 + + + + + select l.link_id, l.url, count(c.link_id) as clicks + from mail_links l, mail_link_mail_map m, mail_link_clicks c + where m.link_id = l.link_id + and m.mail_id = :mail_job_id + and c.mail_id (+) = m.mail_id + and c.link_id (+) = m.link_id + group by l.link_id, l.url + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-track-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,20 @@ + + + + postgresql7.1 + + + + + select l.link_id, l.url, count(c.link_id) as clicks + from mail_links l + inner join mail_link_mail_map m using (link_id) + left outer join mail_link_clicks c + using (mail_id, link_id) + where m.mail_id = :mail_job_id + group by l.link_id, l.url + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + +Link Tracking +@context_bar;noquote@ + + + There are no links tracked in this mail. + + +
    + +
  • @links.url@ + (Link-ID @links.link_id@, @links.clicks@ clicks)
  • +
    +
+
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/link-track.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ +ad_page_contract { +} { + mail_job_id:integer,notnull +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] + +permission::require_permission -object_id $package_id -privilege admin + +set context_bar [list [list "." Administration] [list job-history "Mail Job History"] "Link Tracking"] + +db_multirow links get_links_in_mail {} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,17 @@ + + + + oracle8.1.6 + + + + + begin + ml_mailing_list.delete(:list_id); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,13 @@ + + + + postgresql7.1 + + + + select ml_mailing_list__delete(:list_id); + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete-2.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,12 @@ +ad_page_contract { +} { + list_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $list_id -privilege admin + +db_exec_plsql delete_mailing_list {} + +ad_returnredirect "." Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + +Confirm deletion of mailing list +@context_bar;noquote@ + +

Confirm deletion of the mailing list "@name@":

+

+

+
+ @export_vars;noquote@ + +
+
+ +
+
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ +ad_page_contract { +} { + list_id:integer,notnull +} + +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $list_id -privilege admin + +db_1row get_list_info {} + +set context_bar [list [list "." Administration] "Delete Mailing List"] +set export_vars [export_form_vars list_id] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-delete.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + select name + from ml_mailing_lists + where list_id = :list_id + and package_id = :package_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,81 @@ + + + + oracle8.1.6 + + + + + begin + acs_permission.grant_permission ( + object_id => :list_id, + grantee_id => :the_public_id, + privilege => 'read' + ); + end; + + + + + + + + + begin + acs_permission.revoke_permission ( + object_id => :list_id, + grantee_id => :the_public_id, + privilege => 'read' + ); + end; + + + + + + + + + select acs_permission.permission_p(:list_id, oppm.party_id, :privilege) as permission_p, + oppm.party_id + from acs_object_party_privilege_map oppm + where oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and oppm.party_id <> :user_id + and acs_permission.permission_p(:package_id, oppm.party_id, 'admin') = 'f' + + + + + + + + + begin + acs_permission.grant_permission ( + object_id => :list_id, + grantee_id => :users_id, + privilege => :privilege + ); + end; + + + + + + + + + begin + acs_permission.revoke_permission ( + object_id => :list_id, + grantee_id => :users_id, + privilege => :privilege + ); + end; + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,73 @@ + + + + postgresql7.1 + + + + + select acs_permission__grant_permission ( + :list_id, + :the_public_id, + 'read' + ); + + + + + + + + + select acs_permission__revoke_permission ( + :list_id, + :the_public_id, + 'read' + ); + + + + + + + + + select acs_permission__permission_p(:list_id, oppm.party_id, :privilege) as permission_p, + oppm.party_id + from acs_object_party_privilege_map oppm + where oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and oppm.party_id <> :user_id + and acs_permission__permission_p(:package_id, oppm.party_id, 'admin') = 'f' + + + + + + + + + select acs_permission__grant_permission ( + :list_id, + :users_id, + :privilege + ); + + + + + + + + + select acs_permission__revoke_permission ( + :list_id, + :users_id, + :privilege + ); + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,70 @@ +ad_page_contract { +} { + list_id:integer,notnull + public_p:optional + {users_read:multiple,optional ""} + {users_admin:multiple,optional ""} +} + +set package_id [ad_conn package_id] +set user_id [ad_conn user_id] + +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $list_id -privilege admin + +if {[exists_and_not_null public_p]} { + # toggle public_p + db_transaction { + db_dml update_public_p {} + + set the_public_id [acs_magic_object the_public] + if {$public_p == "t"} { + # grant all users read permissions -> public mailing list + db_exec_plsql grant_user_list_read_privilege {} + } else { + # revoke read permission for all users -> private mailing list + db_exec_plsql revoke_user_list_read_privilege {} + } + } +} else { + # set direct permissions + set add_users [list] + set remove_users [list] + if {![empty_string_p $users_read]} { + # we want to grant read permission to users + template::util::list_to_lookup $users_read admin_ids + set privilege read + } else { + # we want to grant admin permission to users + template::util::list_to_lookup $users_admin admin_ids + set privilege admin + } + + # get all users who've got the mailing_list_admin permission, + # but don't have the admin permission on the package + # (since you can't revoke the read/admin list permissions from them) + db_foreach get_all_mailing_list_admins {} { + if {$permission_p == "f" && [info exists admin_ids($party_id)]} { + # doesn't have the permission right now, but user wants him to + lappend add_users $party_id + } + if {$permission_p == "t" && ![info exists admin_ids($party_id)]} { + # does have the permission right now, but user doesn't want him to + lappend remove_users $party_id + } + } + + db_transaction { + # grant permission to users + foreach users_id $add_users { + db_exec_plsql grant_user_list_privilege {} + } + + # revoke permission from users + foreach users_id $remove_users { + db_exec_plsql revoke_user_list_privilege {} + } + } +} + +ad_returnredirect "list-permissions?[export_url_vars list_id]" Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-2.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + + + + + + + update ml_mailing_lists + set public_p = :public_p + where list_id = :list_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,23 @@ + + + + oracle8.1.6 + + + + + select p.person_id as admin_id, p.first_names, p.last_name, + acs_permission.permission_p(:list_id, p.person_id, 'admin') as admin_p, + acs_permission.permission_p(:list_id, p.person_id, 'read') as read_p, + acs_permission.permission_p(:package_id, p.person_id, 'admin') as package_admin_p + from acs_object_party_privilege_map oppm, persons p + where oppm.party_id = p.person_id + and oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and p.person_id <> :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,23 @@ + + + + postgresql7.1 + + + + + select p.person_id as admin_id, p.first_names, p.last_name, + acs_permission__permission_p(:list_id, p.person_id, 'admin') as admin_p, + acs_permission__permission_p(:list_id, p.person_id, 'read') as read_p, + acs_permission__permission_p(:package_id, p.person_id, 'admin') as package_admin_p + from acs_object_party_privilege_map oppm, persons p + where oppm.party_id = p.person_id + and oppm.object_id = :package_id + and oppm.privilege = 'mailing_list_admin' + and p.person_id <> :user_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,37 @@ + +Manage mailing list permissions +@context_bar;noquote@ + + +

This mailing list "@name@" is public. All other admins can use it.

+ Make private +
+ +

This mailing list "@name@" is private. + + The following admins can use it:

+
+ @export_vars;noquote@ + + checked> @users_read.first_names@ @users_read.last_name@
+
+

+ +

+ + + + Make public + + + +

The following admins can edit/delete/use this mailing list:

+
+ @export_vars;noquote@ + + checked> @users_admin.first_names@ @users_admin.last_name@
+
+

+ +

+ Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,31 @@ +ad_page_contract { +} { + list_id:integer,notnull +} + +set package_id [ad_conn package_id] +set user_id [ad_conn user_id] + +permission::require_permission -object_id $package_id -privilege mailing_list_admin +permission::require_permission -object_id $list_id -privilege admin + +db_1row get_list_info {} + +template::multirow create users_read user_id first_names last_name read_p +template::multirow create users_admin user_id first_names last_name admin_p + +db_foreach get_all_mailing_list_admins {} { + if {$package_admin_p == "f"} { + # you can't revoke the mailing_list_admin permission from package admins + # so it doesn't make sense to show them + if {$admin_p == "f"} { + template::multirow append users_read $admin_id $first_names $last_name $read_p + } + template::multirow append users_admin $admin_id $first_names $last_name $admin_p + } +} + +set context_bar [list [list "." Administration] "Mailing List Permissions"] +set export_vars [export_form_vars list_id] + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-permissions.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,16 @@ + + + + + + + select name, public_p + from ml_mailing_lists + where list_id = :list_id + and package_id = :package_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,18 @@ + + + + oracle8.1.6 + + + + + select name, list_id as value + from ml_mailing_lists + where acs_permission.permission_p (list_id, :user_id, 'read') = 't' + order by lower(name) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,18 @@ + + + + postgresql7.1 + + + + + select name, list_id as value + from ml_mailing_lists + where acs_permission__permission_p (list_id, :user_id, 'read') = 't' + order by lower(name) + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,7 @@ + +Mass Subscribe +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,102 @@ +ad_page_contract { +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +set context_bar [list [list "." Administration] "Mass Subscribe to Mailing List"] + +set lists [db_list_of_lists get_mailing_lists {}] + + +ad_form -name list_mass_subscribe_form -action list-subscribe -form { + {list_id:text(select) {label "Mailing List"} {options $lists}} + {xx:text(inform) {label " "} {value "Enter emails and 2-character country code as a comma-seperated list (csv)"}} + {emails_countries:text(textarea) {label "Emails and Countries"} {html {rows 30 cols 80}}} + {confirmation_p:text(checkbox),optional {label "Send confirmation?"} {options {{"Yes" t}}}} +} -validate { + {emails_countries { + [empty_string_p [set invalid_list [mailing_list::util::check_valid_country_codes -emails_and_countries $emails_countries]]]} + "Invalid country code for emails: [join $invalid_list , ]"} + {emails_countries { + [empty_string_p [set invalid_list [mailing_list::util::check_valid_emails -emails_and_countries $emails_countries]]]} + "Invalid emails: [join $invalid_list , ]"} +} -on_submit { + permission::require_permission -object_id $list_id -privilege read + + if {[exists_and_not_null confirmation_p]} { + set confirmed_p f + } else { + set confirmed_p t + } + set default_first_names "Unknown" + set default_last_name "User" + set default_question "q" + set default_answer "a" + + db_1row get_list_mail_data {} + + # get all mappings country_code -> country_id so that we can map users + # to country_ids a lot easier + db_foreach get_country_codes {} { + set country_id($country_code) $category_id + } + + # generate tmp-file for csv-processing + set tmp_file [ns_tmpnam] + set fd [open $tmp_file w] + puts $fd $emails_countries + close $fd + set fd [open $tmp_file r] + + set unsubscribe_link "[ad_url][ad_conn package_url]" + + db_transaction { + # process every line of the user/country list + while {[ns_getcsv $fd line] > 0} { + + set user_id "" + # grap the email and country of the current line + util_unlist $line email country + + # check if user already exists + set user_id [cc_email_user $email] + + if {[empty_string_p $user_id]} { + # user doesn't exist, so create him + set user_password [ad_generate_random_string] + set user_id [ad_user_new $email $default_first_names $default_last_name $user_password $default_question $default_answer "" $confirmed_p] + } else { + set user_password "" + } + + set confirmation_link "[ad_url][ad_conn package_url]confirm?[export_url_vars list_id user_id]" + + # try to map user to the given country - this might fail if user + # is already mapped + catch {[category::map_object -remove_old -object_id $user_id $country_id($country)]} + + # subscribe user. check if user already has a map entry + if {[mailing_list::add_user -list_id $list_id -user_id $user_id -confirmed_p $confirmed_p]} { + # user is newly added to this list + # now send confirmation message to user if requested + if {$confirmed_p == "f"} { + mailing_list::util::send_mail -user_id $user_id -from_email $sender_email -subject $confirm_subject -body $confirm_body -mime_type $confirm_mime_type -charset $mime_charset -link $confirmation_link -new_password $user_password + } else { + # send welcome message if no confirmation needed + mailing_list::util::send_mail -user_id $user_id -from_email $sender_email -subject $welcome_subject -body $welcome_body -mime_type $welcome_mime_type -charset $mime_charset -link "$unsubscribe_link?[export_url_vars user_id]" -new_password $user_password + } + } + } + } + + # remove tmp-file for csv processing + close $fd + ns_unlink $tmp_file +} -after_submit { + ad_returnredirect "." + ad_script_abort +} + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,27 @@ + + + + + + + select m.sender_email, m.confirm_subject, m.confirm_body, m.confirm_mime_type, + m.welcome_subject, m.welcome_body, m.welcome_mime_type, l.mime_charset + from ml_mailing_lists m, ad_locales l + where m.list_id = :list_id + and l.locale = m.locale + + + + + + + + + select country_code, category_id + from ml_country_codes + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/lists-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/lists-oracle.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/lists-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + + + + oracle8.1.6 + + + + + select to_char(sysdate,'YYYY MM DD') as expiration_date from dual + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/lists-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/lists-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/lists-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,15 @@ + + + + postgresql7.1 + + + + + select to_char(current_timestamp,'YYYY MM DD') as expiration_date + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/lists.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/lists.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/lists.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,7 @@ + +@action@ a Mailing List +@context_bar;noquote@ + +
+ +
Index: openacs-4/contrib/packages/mailing-lists/www/madmin/lists.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/lists.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/lists.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,125 @@ +ad_page_contract { +} { + list_id:integer,optional +} + +set user_id [ad_maybe_redirect_for_registration] +set package_id [ad_conn package_id] +permission::require_permission -object_id $package_id -privilege mailing_list_admin + +if {[info exists list_id]} { + set _list_id $list_id + set action Edit +} else { + set _list_id 0 + set action Add +} + +set context_bar [list [list "." Administration] "$action Mailing List"] + +set languages [db_list_of_lists get_ad_locales {}] + +ad_form -name mailing_list_form -action lists -form { + {list_id:key} + {name:text {label "Name"} {html {size 50 maxlength 1000}}} + {locale:text(select) {label "Language"} {options $languages}} + {teaser:text(textarea) {label "Teaser"} {html {rows 5 cols 80}}} +} + +if {![empty_string_p [category_tree::get_mapped_trees $package_id]]} { + ad_form -extend -name mailing_list_form -form { + {category_ids:integer(category),multiple,optional {label "Categories"} {html {size 4}} {options {$_list_id $package_id}}} + } +} + +ad_form -extend -name mailing_list_form -form { + {sender_email:text {label "Mail Sender"} {html {size 50 maxlength 1000}}} + {confirm_subject:text {label "Confirmation Mail Subject"} {html {size 50 maxlength 1000}}} + {confirm_body:text(textarea) {label "Confirmation Mail Body"} {html {rows 5 cols 80}}} + {confirm_mime_type:text(select) {label "Confirmation Mail Type"} {options {{"Plain Text" text/plain} {"HTML" text/html}}}} + {welcome_subject:text {label "Welcome Mail Subject"} {html {size 50 maxlength 1000}}} + {welcome_body:text(textarea) {label "Welcome Mail Body"} {html {rows 5 cols 80}}} + {welcome_mime_type:text(select) {label "Welcome Mail Type"} {options {{"Plain Text" text/plain} {"HTML" text/html}}}} + {remind_subject:text {label "Reminder Mail Subject"} {html {size 50 maxlength 1000}}} + {remind_body:text(textarea) {label "Reminder Mail Body"} {html {rows 5 cols 80}}} + {remind_mime_type:text(select) {label "Reminder Mail Type"} {options {{"Plain Text" text/plain} {"HTML" text/html}}}} + {expiration_date:date,to_sql(sql_date),to_html(sql_date) {label "Expiration Date"} {format "DD MONTH YYYY"}} + {first_reminder:integer {label "1st Confirmation Reminder"} {html {size 5 maxlength 5}}} + {second_reminder:integer {label "2nd Confirmation Reminder"} {html {size 5 maxlangth 5}}} + {comments:text(textarea),optional {label "Comments"} {html {rows 5 cols 80}}} +} -new_request { + set name "" + set locale [ad_conn locale] + set teaser "" + set create_class_p t + set sender_email "lists@greenpeace.org" + set confirm_subject "" + set confirm_body "" + set confirm_mime_type "text/plain" + set welcome_subject "" + set welcome_body "" + set welcome_mime_type "text/plain" + set remind_subject "" + set remind_body "" + set remind_mime_type "text/plain" + set first_reminder 7 + set second_reminder 0 + set comments "" + db_1row get_current_date {} +} -edit_request { + permission::require_permission -object_id $list_id -privilege admin + + db_1row get_list_data {} +} -validate { + {confirm_body { + [empty_string_p [mailing_list::util::check_valid_vars -text $confirm_body -valid_vars [list user_id user_password x link]]]} + "In the confirmation email you can only use the template variables @user_id@, @user_password@, @link@ and @x@."} + {confirm_body { + [regexp {@link@} $confirm_body match] || [regexp {@x@} $confirm_body match]} + "You have to use either @x@ or @link@ to provide the user a confirmation link."} + {welcome_body { + [empty_string_p [mailing_list::util::check_valid_vars -text $welcome_body -valid_vars [list user_id user_password link]]]} + "In the welcome email you can only use the template variables @user_id@, @user_password@ and @link@."} + {remind_body { + [empty_string_p [mailing_list::util::check_valid_vars -text $remind_body -valid_vars [list user_id x link]]]} + "In the reminder email you can only use the template variables @user_id@, @x@ and @link@."} +} -new_data { + set list_id [mailing_list::add -name $name -locale $locale -teaser $teaser \ + -sender_email $sender_email -welcome_subject $welcome_subject \ + -welcome_body $welcome_body -welcome_mime_type $welcome_mime_type \ + -confirm_subject $confirm_subject -confirm_body $confirm_body \ + -confirm_mime_type $confirm_mime_type \ + -remind_subject $remind_subject -remind_body $remind_body \ + -remind_mime_type $remind_mime_type -expiration_date $expiration_date \ + -first_reminder $first_reminder -second_reminder $second_reminder \ + -comments $comments] + + if {[exists_and_not_null category_ids]} { + category::map_object -object_id $list_id $category_ids + } +} -edit_data { + permission::require_permission -object_id $list_id -privilege admin + + mailing_list::edit -list_id $list_id -name $name -locale $locale -teaser $teaser \ + -sender_email $sender_email -welcome_subject $welcome_subject \ + -welcome_body $welcome_body -welcome_mime_type $welcome_mime_type \ + -confirm_subject $confirm_subject -confirm_body $confirm_body \ + -confirm_mime_type $confirm_mime_type -remind_subject $remind_subject \ + -remind_body $remind_body -remind_mime_type $remind_mime_type \ + -expiration_date $expiration_date -first_reminder $first_reminder \ + -second_reminder $second_reminder -comments $comments + + if {[exists_and_not_null category_ids]} { + category::map_object -remove_old -object_id $list_id $category_ids + } +} -after_submit { + ad_returnredirect "." + ad_script_abort +} + +ad_return_template +return + + {category_ids { + [category::categorized_in_all_trees_p $package_id $category_ids]} + "You have to select at least one category from each tree."} Index: openacs-4/contrib/packages/mailing-lists/www/madmin/lists.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/lists.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/lists.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,29 @@ + + + + + + + select label as name, locale as value + from ad_locales + + + + + + + + select name, locale, teaser, sender_email, welcome_subject, welcome_body, + welcome_mime_type, confirm_subject, confirm_body, confirm_mime_type, + remind_subject, remind_body, remind_mime_type, + to_char(expiration_date,'YYYY MM DD') as expiration_date, + first_reminder, second_reminder, comments + from ml_mailing_lists + where list_id = :list_id + and package_id = :package_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/master.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/master.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/master.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,7 @@ + +@title;noquote@ +@context_bar;noquote@ + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/master.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/master.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/master.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,4 @@ +# There seems to be no way to elegantly set default values here +if { ![info exists context_bar] } { + set context_bar "" +} Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region-postgresql.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,28 @@ + + + + + + SELECT url FROM mail_links WHERE link_id = :link_id + + + + + + + + + SELECT count(*) as number_clicks , (com.category_id) as country_id , c.parent_id + FROM mail_link_clicks mlc , category_object_map com, categories c + WHERE mlc.link_id = :link_id + AND mlc.mail_id = :mail_job_id + AND mlc.user_id = com.object_id + AND com.category_id = c.category_id + group by country_id , c.parent_id + order by country_id, c.parent_id + + + + + + Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,27 @@ + +Mail Link Clicks for Region and Country +@context_bar@ + +Show Weekly Charts +

Link name @url@

+ + + + + + + + +
+ + + + +
Total Clicks@overall_clicks@
@regions.pretty_region@@regions.clicks@
+ + + + + + +
@regions.pretty_region@@regions.clicks@
   @all_countries.pretty_country@@all_countries.clicks@
\ No newline at end of file Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,64 @@ +ad_page_contract { + Show all clicks on a link from a given mail job , brocken down by Region and Country within Region. + + +} { + + + + link_id:notnull + mail_job_id:notnull + + +} -properties { + + all_countries:multirow + regions:multirow + overall_clicks:onevalue + url:onevalue +} + + + +set package_id [ad_conn package_id] +set context_bar [list [list "." Administration] [list job-history "Mail Job History"] [list link-track?mail_job_id=$mail_job_id "Link Tracking"] "Alphanumeric Statistics"] +set mailing_list_package_id [user_register::util::get_sw_package_id -package_key mailing-lists] + + +if {![db_0or1row get_current_country_category_tree {select tree_id + from ml_country_category_tree + where package_id = :mailing_list_package_id}]} { + # no country tree mapped, so return to index page immediately + ad_returnredirect "." + return +} + + + + +template::multirow create all_countries region_id pretty_country clicks + +set cur_parent_id 0 + +db_1row get_link_url {} + + +db_foreach get_all_clicks_for_link {} { + if {$cur_parent_id != $parent_id} { + set total_clicks($parent_id) 0 + set cur_parent_id $parent_id + } + + template::multirow append all_countries $parent_id [category::get_name $country_id] $number_clicks + set total_clicks($parent_id) [expr $total_clicks($parent_id) + $number_clicks] + } + + + +template::multirow create regions pretty_region clicks region_id +set overall_clicks 0 + +foreach region_id [array names total_clicks] { + template::multirow append regions [category::get_name $region_id] $total_clicks($region_id) $region_id + set overall_clicks [expr $overall_clicks + $total_clicks($region_id)] +} Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.adp,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.adp 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,36 @@ + +Administer Country Codes +@context_bar;noquote@ + +

@pretty_week_date@

+ +<%=$image_map%> + + + + + + + + + +
Move one Week
+ + << Backward + + + No Previous Week. + + + + Forward >> + + + No further Week! + +
+ + +

No Data available !

+
No one has used this Link
+
\ No newline at end of file Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.tcl 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,331 @@ +ad_page_contract { + Show weekly cliks on a link from a given mail job , brocken down by hour. + + @cvs-id $Id: stats-weekly.tcl,v 1.1 2003/10/01 05:01:55 maltes Exp $ +} { + + + + date:optional + {adp_list_name "GENERAL"} + sel_month:optional + sel_year:optional + link_id:notnull + mail_job_id:notnull + {type "list"} + +} -properties { + context_bar:onevalue + subscriptions:multirow + dates_available:onevalue + next_week_available:onevalue + last_week_available:onevalue + next_week:onevalue + last_week:onevalue + pretty_week_date:onevalue +} + + +### some preparation +set julian_linux_diff 2440588 +set dates_available true +set date_first 0 +set date_last 0 + + + + +set package_id [ad_conn package_id] +set context_bar [list [list "." Administration] [list job-history "Mail Job History"] [list link-track?mail_job_id=$mail_job_id "Link Tracking"] [list stats-all-region?link_id=$link_id&mail_job_id=$mail_job_id "Alphanumeric Statistics"] "Chart Statistics"] +set mailing_list_package_id [user_register::util::get_sw_package_id -package_key mailing-lists] + + +if {![db_0or1row get_current_country_category_tree {select tree_id + from ml_country_category_tree + where package_id = :mailing_list_package_id}]} { + # no country tree mapped, so return to index page immediately + ad_returnredirect "." + return +} + + + + +# set the date var if it wasn't supplied (directly) in the querry +if {![info exists date]} { + + if {[info exists sel_year] && [info exists sel_month]} { + set date [expr $sel_year + [expr [expr $sel_month - 1] * 31]] + } else { + # set date to current date + set count 0 + + db_foreach get_first_date { + select count(*) as number_clicks, to_char(l.click_time,'J') as cur_date, + p.category_id + from mail_link_clicks l, category_object_map cm, categories c, categories p + where l.link_id = :link_id + and l.mail_id = :mail_job_id + and cm.object_id = l.user_id + and cm.category_id = c.category_id + and c.tree_id = :tree_id + and c.parent_id = p.category_id + group by cur_date , p.category_id + order by cur_date ,p.category_id } { + + if {$count == 0} { + set date $cur_date + set date_first $cur_date + incr count + } + + + } if_no_rows {dates_available "false"} + + if {$dates_available == true} { + + set date_last $cur_date + } else { + # If no one has clicked the link(_id) in this mail(_job_id) we dont need a Chart. + ad_return_template + ad_script_abort + } + + } +} + + + +set count 0 + +#multirow create image_names image_name region_id list_id region + +set region_value_lists [list ] +set region_day_lists [list ] +set count 0 + +db_foreach get_category_ids_for_region {} { + + set regions_array($cur_category_id) [category::get_name $cur_category_id] + lappend region_ids_list $cur_category_id + set region_values($cur_category_id) [list] + set region_days($cur_category_id) [list] + set region_lists_index($cur_category_id) $count + + lappend region_value_lists [list 0 0] + lappend region_day_lists [list start point] + set count [expr $count + 1] + set bar_chart_array($cur_category_id) 0 +} + + +### some preparation end + + + + + + + + + +### we have to display weekly stats split in all 168 hours +set this_week_start [expr $date - [ns_fmttime [expr [expr $date - $julian_linux_diff] * 86400] "%w"]] +set this_week_end [expr $this_week_start + 6] +set number_of_intervals 168 +set pretty_week_date [ns_fmttime [expr [expr $this_week_start - $julian_linux_diff] * 86400] "The Week from %A the %d of %B %Y"] +append pretty_week_date [ns_fmttime [expr [expr $this_week_end - $julian_linux_diff] * 86400] " -- to %A the %d of %B %Y"] + +# we proberbly won't need a multirow here () +template::multirow create pretty_regions region_name +set bar_chart_legende [list] + +foreach bar_region [array names bar_chart_array] { + + lappend bar_chart_legende [category::get_name $bar_region] + # Create a mult. with region lables + template::multirow append pretty_regions [category::get_name $bar_region] + + # Create a ns_set for each region + set temp_set [ns_set create] + + # Loop through all 168 hours of this week + # I split the Loop into two Loops one counts the days (7) one the hours of a day (24) + # This makes it easyer to create a datetime value. + + for {set this_week_day 0} {$this_week_day < 7} {incr this_week_day} { + + for {set cur_hours 0} {$cur_hours < 24} {incr cur_hours} { + + set cur_day_date [expr $this_week_day + $this_week_start] + # set format like "24 12 2000" + set time_stamp [ns_fmttime [expr [expr $cur_day_date - $julian_linux_diff] * 86400] "%d %m %Y" ] + append time_stamp " " + if {[string len $cur_hours] == 1} { + append time_stamp "0" + } + + append time_stamp $cur_hours + + ns_set cput $temp_set $time_stamp 0 + + ### set all possible hours of this week to 0 values + + + } + + } + + # Put all set id's into a array the keys are the region id's + set bar_chart_array($bar_region) $temp_set +} + + +for {set i 1} {$i <= 168} {incr i} { + ns_log notice "remainder = [expr $i % 12] , div = [expr $i / 12] " + if { [expr $i % 12] == 0} { + set test [expr $i / 12] + switch $test { + 1 {lappend bar_chart_lables "Sunday"} + 3 {lappend bar_chart_lables "Monday"} + 5 {lappend bar_chart_lables "Tusday"} + 7 {lappend bar_chart_lables "Wendsday"} + 9 {lappend bar_chart_lables "Thursday"} + 11 {lappend bar_chart_lables "Friday"} + 13 {lappend bar_chart_lables "Saturday"} + + default {lappend bar_chart_lables ""} + } + + + } else { + lappend bar_chart_lables "" + } +} + + + + +# Now query the db for all clicks of this week. I formate the click_time to a +# datetime value, wich is precise to one hour and equaly formated as the keys +# of the above createt sets. + +set time_stamp_start [ns_fmttime [expr [expr $this_week_start - $julian_linux_diff] * 86400] "%d %m %Y" ] +set time_stamp_end [ns_fmttime [expr [expr [expr $this_week_end - $julian_linux_diff] * 86400] + 86401] "%d %m %Y" ] +append time_stamp_start " 00" +append time_stamp_end " 00" + + + + +db_foreach get_link_clicks_dev {} { + + ns_set update $bar_chart_array($category_id) $cur_ns_set_key $number_clicks + +} + + + + + + + +# Get out the values from the ns_set and stuff then into lists, +# Which the Chart drawing functions expect. + +set bar_chart_values [list] +lappend bar_chart_values $bar_chart_lables + +foreach bar_region [array names bar_chart_array] { + + set temp_list [list] + set temp_set $bar_chart_array($bar_region) + + for {set this_week_day 0} {$this_week_day < 7} {incr this_week_day} { + + for {set cur_hours 0} {$cur_hours < 24} {incr cur_hours} { + + set cur_day_date [expr $this_week_day + $this_week_start] + # set format like "24 12 2000" + set time_stamp [ns_fmttime [expr [expr $cur_day_date - $julian_linux_diff] * 86400] "%d %m %Y" ] + append time_stamp " " + if {[string len $cur_hours] == 1} { + append time_stamp "0" + } + + append time_stamp $cur_hours + lappend temp_list [ns_set value $temp_set [ns_set find $temp_set $time_stamp]] + + } + } + + lappend bar_chart_values $temp_list + +} + + + +set file_name "link-detail-$link_id-$mail_job_id-$this_week_start" + +set ret_val [tgdchart::smallstackbar -file $file_name -title "Link Clicks for one Week" -ytitle "Clicks" -xtitle "Hours" -values "$bar_chart_values" -legende $bar_chart_legende] + + +set file_name [lindex $ret_val 0] +set image_map [lindex $ret_val 1] + +# The Chart Image is created , now create the back and forth links +# Get the first and last day, someone clicked the link (if we haven't gotten it yet) + +if {$date_last == 0 && $date_first == 0} { + + set count 0 + + db_foreach get_first_date {} { + + if {$count == 0} { + set date_first $cur_date + incr count + } + + + } if_no_rows {dates_available "false"} + +} + + +if {$dates_available == true} { + + set date_last $cur_date + + + + set first_week_start [expr $date_first - [ns_fmttime [expr [expr $date_first - $julian_linux_diff] * 86400] "%w"]] + + if {$first_week_start < $this_week_start} { + set last_week_available true + set last_week [expr $this_week_start - 6] + } else { + set last_week_available false + } + + set last_week_start [expr $date_last - [ns_fmttime [expr [expr $date_last - $julian_linux_diff] * 86400] "%w"]] + + if {$last_week_start > $this_week_start} { + set next_week_available true + set next_week [expr $this_week_start + 7] + } else { + set next_week_available false + } +} + + + + + + + + + + + +ad_return_template Index: openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.xql,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.xql 1 Oct 2003 05:01:55 -0000 1.1 @@ -0,0 +1,53 @@ + + + + + + + select count(*) as number_clicks, to_char(l.click_time,'J') as cur_date, + p.category_id + from mail_link_clicks l, category_object_map cm, categories c, categories p + where l.link_id = :link_id + and l.mail_id = :mail_job_id + and cm.object_id = l.user_id + and cm.category_id = c.category_id + and c.tree_id = :tree_id + and c.parent_id = p.category_id + group by cur_date , p.category_id + order by cur_date ,p.category_id + + + + + + + + + SELECT category_id as cur_category_id FROM categories WHERE tree_id = :tree_id AND parent_id is null + + + + + + + + + select count(*) as number_clicks, to_char(l.click_time,'DD MM YYYY HH24') as cur_ns_set_key, + p.category_id + from mail_link_clicks l, category_object_map cm, categories c, categories p + where l.link_id = :link_id + and l.mail_id = :mail_job_id + and l.click_time >= to_timestamp(:time_stamp_start , 'DD MM YYYY HH24') + and l.click_time < to_timestamp(:time_stamp_end , 'DD MM YYYY HH24') + and cm.object_id = l.user_id + and cm.category_id = c.category_id + and c.tree_id = :tree_id + and c.parent_id = p.category_id + group by cur_ns_set_key , p.category_id + order by p.category_id, cur_ns_set_key + + + + + +