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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-create.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-create.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -272,40 +272,5 @@ 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-drop.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-drop.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -2,9 +2,6 @@ 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; 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-package.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/oracle/mailing-lists-package.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -100,9 +100,6 @@ 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, @@ -170,10 +167,6 @@ 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 @@ -308,9 +301,6 @@ 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, @@ -386,10 +376,6 @@ 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 @@ -527,9 +513,6 @@ 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, @@ -606,10 +589,6 @@ 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 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-create.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-create.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -255,40 +255,5 @@ 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-drop.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-drop.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -1,8 +1,5 @@ \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; 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-create.sql 1 Oct 2003 05:01:53 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/sql/postgresql/mailing-lists-package-create.sql 21 Jan 2004 19:22:14 -0000 1.2 @@ -39,9 +39,6 @@ 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, @@ -117,10 +114,6 @@ 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 @@ -189,10 +182,6 @@ 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, @@ -293,10 +282,6 @@ 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 @@ -372,9 +357,6 @@ 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, @@ -466,10 +448,6 @@ 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 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/email-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs.tcl 21 Jan 2004 19:22:14 -0000 1.2 @@ -41,6 +41,11 @@ set template_p t } + if {$mail_mime_type != "text/plain"} { + # substitute image link to track viewing the mail + regsub -all -nocase {(@view_mail_link@)} $html_body "" html_body + } + set attachments "" # encode all attachments in base64 db_foreach get_attachments {} { @@ -86,7 +91,7 @@ ###### # 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 alternative_body "\n--$alternative_string\nContent-Type: text/html; charset=$mime_charset\n" set attachments "\n--$alternative_string\--\n$attachments" } } @@ -114,7 +119,7 @@ ###### # 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 alternative_body "\n--$boundary_string\nContent-Type: text/html; charset=$mime_charset\n" set attachments "\n--$boundary_string\--" } } @@ -135,6 +140,8 @@ } if {$mail_mime_type != "text/plain"} { + # we have to use noquote-substitution for mail view tracking in html mails + while {[regsub -all -nocase {@view_mail_link@} $html_body {@view_mail_link;noquote@} html_body]} {} # 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]} {} @@ -210,6 +217,7 @@ } } + set unsubscribe_link "[ad_url][lindex [site_node::get_url_from_object_id -object_id $package_id] 0]" set mail_count 0 # loop over all users to spam foreach one_user_set $user_list { @@ -219,8 +227,24 @@ 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) + set user_password $one_user(user_password) + set user_salt $one_user(user_salt) + if {[string equal $user_first_names "first_names"]} { + set user_first_names "" + set one_user(user_first_names) "" + } + if {[string equal $user_last_name "last_name"]} { + set user_last_name "" + set one_user(user_last_name) "" + } + if {$template_p == "t"} { + # generate link-variable + # so that users are automatically logged in to unsubscribe + set x [ns_sha1 "$user_id $user_password $user_salt"] + set one_user(link) "$unsubscribe_link?[export_url_vars user_id x]" + # now substitute variables in mailbody ::mailing_list::__substitute_mail @@ -236,8 +260,9 @@ # 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) " " + + if {[empty_string_p $user_last_name]} { + set to_addr(name) [list $user_first_names] } else { set to_addr(name) [list "$user_first_names $user_last_name"] } @@ -282,7 +307,8 @@ ad_proc -private base64_encode { -filename:required } { - set fp [open "|/usr/bin/mmencode -b $filename" r] + set mmencode_path [acs_mail_lite::get_parameter -name MMEncodeBin -default "/usr/bin/mmencode"] + set fp [open "|$mmencode_path -b $filename" r] set quoted [read $fp] close $fp return $quoted @@ -412,10 +438,11 @@ 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 $expression $text "clicks/$link_id\.$mail_job_id\.@user_id@" text } regsub -all {([^<]*)} $text $server_url_substitution text + return $text } 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/email-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/email-procs.xql 21 Jan 2004 19:22:14 -0000 1.2 @@ -23,7 +23,8 @@ select u.user_id, p.first_names as user_first_names, - p.last_name as user_last_name, i.email as user_email + p.last_name as user_last_name, i.email as user_email, + u.password as user_password, u.salt as user_salt 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' 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-oracle.xql 21 Jan 2004 19:22:14 -0000 1.2 @@ -69,13 +69,14 @@ 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, + ml.list_id, n.node_id, ml.package_id + from ml_mailing_lists ml, ml_mailing_list_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 n.object_id = ml.package_id + and ml.remind_body is not null and ((m.reminder_count = 0 and ml.first_reminder > 0 and m.subscription_date < sysdate - ml.first_reminder) 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs-postgresql.xql 21 Jan 2004 19:22:14 -0000 1.2 @@ -78,13 +78,14 @@ 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, + ml.list_id, n.node_id, ml.package_id + from ml_mailing_lists ml, ml_mailing_list_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 n.object_id = ml.package_id + and ml.remind_body is not null and ((m.reminder_count = 0 and ml.first_reminder > 0 and m.subscription_date < (current_timestamp - 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.tcl 21 Jan 2004 19:22:14 -0000 1.2 @@ -115,10 +115,13 @@ set reminders [db_list_of_lists get_unconfirmed_subscriptions {}] # send reminder + ad_conn -set package_key mailing-lists 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]" + util_unlist $reminder user_id sender_email remind_subject remind_body remind_mime_type mime_charset list_id node_id package_id + ad_conn -set package_id $package_id + set confirmation_link "[ad_url][site_node::get_url -node_id $node_id]confirm?[export_url_vars list_id user_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" 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/mailing-lists-procs.xql 21 Jan 2004 19:22:14 -0000 1.2 @@ -50,6 +50,7 @@ update ml_mailing_list_user_map set reminder_count = reminder_count + 1 where user_id = :user_id + and list_id = :list_id 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/util-procs.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs.tcl 21 Jan 2004 19:22:14 -0000 1.2 @@ -78,6 +78,15 @@ } db_1row get_user_data {} + if {[string equal $user_first_names "first_names"]} { + set user_first_names "" + } + if {[string equal $user_last_name "last_name"]} { + set user_last_name "" + set user_name $user_first_names + } else { + set user_name "$user_first_names $user_last_name" + } # generate the x-variable that's needed to verify the users identity # when he clicks the link @@ -136,59 +145,25 @@ 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 + -emails:required } { - Checks the csv-list of emails and countries for valid email addresses + Checks the csv-list of emails 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 + puts $fd $emails close $fd set fd [open $tmp_file r] set invalid_list "" - # process every line of the user/country list + # process every line of the email list while {[ns_getcsv $fd line] > 0} { - # grap the email and country of the current line - util_unlist $line email country + # grap the email of the current line + util_unlist $line email user_first_names user_last_name if {![util_email_valid_p $email]} { # invalid email address 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/tcl/util-procs.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/tcl/util-procs.xql 21 Jan 2004 19:22:14 -0000 1.2 @@ -5,7 +5,7 @@ select u.password as user_password, u.salt as user_salt, - p.first_names || ' ' || p.last_name as user_name, + p.first_names as user_first_names, p.last_name as user_last_name, y.email as user_email from users u, persons p, parties y where u.user_id = :user_id @@ -19,26 +19,12 @@ - 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 + select u.password as user_password, u.salt as user_salt + from users u 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/index-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql,v diff -u -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/index-oracle.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -24,7 +24,7 @@ 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 + category_object_map cm, categories c where l.package_id = :package_id and l.list_id = m.list_id(+) and m.user_id(+) = :user_id @@ -33,11 +33,26 @@ 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) + + + + select l.list_id, l.name, l.teaser, + nvl(m.subscribed_p, 'f') as subscribed_p + 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 m.user_id(+) = :user_id + and l.public_p = 't' + and l.locale = :locale + and l.expiration_date > sysdate + order by 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/index-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/index-postgresql.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -29,16 +29,32 @@ 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) + + + + select l.list_id, l.name, l.teaser, + 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) + where l.package_id = :package_id + and l.public_p = 't' + and l.locale = :locale + and l.expiration_date > current_timestamp + order by 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/index.adp 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/index.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -6,46 +6,43 @@ - -

Mailing Lists you are already subscribed to

-
- - - -
- + + +

Mailing Lists you are already subscribed to

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

Available Mailing Lists

- -
-
    - -

    @lists.tree_name@

    - - @lists.category_name@
      - -
    • @lists.name@ -
      @lists.teaser@
      • -       -
    -     + + + + + +

    Available Mailing Lists

    + +
    +
      + +
    • @lists.name@ +
      @lists.teaser@

      • +       +
    + +
    +     + No mailing lists available in this language. + - No mailing lists available in this language. +

    Please check your email and confirm your email adress by clicking on the link provided in the email we sent you.

     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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/index.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/index.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -26,24 +26,30 @@ 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] -} +set context_bar "" -db_multirow subscribed_lists get_lists_user_is_subscribed {} +db_1row check_email_verified_p {} -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 +if {$email_verified_p == "t"} { + if {![info exists locale]} { + set locale [ad_conn locale] } -} -db_multirow languages get_languages {} + db_multirow subscribed_lists get_lists_user_is_subscribed {} -set context_bar "" +# template::multirow create lists list_id name teaser tree_id tree_name category_id category_name + template::multirow create lists list_id name teaser + db_foreach get_lists_by_language_new {} { + 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 + template::multirow append lists $list_id $name $teaser + } + } + + db_multirow languages get_languages {} +} + 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/index.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/index.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -10,5 +10,16 @@ + + + + + select email_verified_p + from users + where 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -8,32 +8,36 @@ 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 check_email_verified_p {} + +if {$email_verified_p == "t"} { + 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 {} } - db_1row get_welcome_text {} + } + } 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]" + 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 + # 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 + } } } } 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/list-toggle-subscribe.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -1,6 +1,17 @@ + + + + select email_verified_p + from users + where user_id = :user_id + + + + + 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/classes.tcl 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/classes.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -101,7 +101,7 @@ } else { set name "" set locale [ad_conn locale] - set sender_email "info@greenpeace.org" + set sender_email [ad_system_owner] set subject "" set subject_change_p t set text_header "" 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/index.adp 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/index.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -3,16 +3,8 @@ @context_bar;noquote@ Administer Categories -
    -Change Visible Categories -
    -Change Country Category -
    -Administer Country Codes -
    -Administer Users Selections +

    -

    Mailing Lists

      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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-postgresql.xql 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-add-postgresql.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -19,7 +19,7 @@ select list_id, name from ml_mailing_lists - where acs_permission__permission_p(list_id, :user_id, 'read') = 't' + where acs_permission__permission_p(list_id, :user_id, 'admin') = 't' and expiration_date > current_timestamp 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.adp 1 Oct 2003 05:01:54 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -26,6 +26,10 @@

      Link Tracking + +

      View Tracking + +

      Attachments:

        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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-detail.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -36,14 +36,28 @@ } if {![empty_string_p $html_body]} { set html_body "$html_header\n$html_body\n$html_footer" + # while {[regsub -all -nocase {]*?>} $mail_html_body {} mail_html_body]} {} } +if {[string first "@view_mail_link@" $html_body] > -1} { + # mail contains a link to track views of email + set track_views_p t + if {[empty_string_p $selection_id]} { + # we have to use noquote-substitution for mail view tracking in html mails + while {[regsub -all -nocase {@view_mail_link@} $html_body {@view_mail_link;noquote@} html_body]} {} + } +} else { + set track_views_p f +} + 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" + set link "[ad_url][ad_conn package_url]?user_id=$user_id&x=some_x_test" + set view_mail_link "" variable ::template::parse_level lappend ::template::parse_level [info level] 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-oracle.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -28,8 +28,9 @@ 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 + j.track_links_p, p.first_names as user_first_names, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date, + p.last_name as user_last_name 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') 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2-postgresql.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -29,8 +29,9 @@ 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 + j.track_links_p, p.first_names as user_first_names, + to_char(j.execution_date, 'YYYY-MM-DD HH24:MI') as execution_date, + p.last_name as user_last_name 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') 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.adp 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -10,10 +10,10 @@
          -
        • *** No Subject *** +
        • *** No Subject *** -
        • @jobs.subject@ +
        • @jobs.subject@ (created by @jobs.user_name@, sent @jobs.mails_sent@ on @jobs.execution_date@, status: @jobs.state@) (Link Tracking) 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-history-2.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -42,7 +42,17 @@ } } -db_multirow jobs ml_mail_job_history {} +db_multirow -extend {user_name} jobs ml_mail_job_history {} { + if {[string equal $user_first_names "first_names"]} { + set user_first_names "" + } + if {[string equal $user_last_name "last_name"]} { + set user_last_name "" + set user_name $user_first_names + } else { + set user_name "$user_first_names $user_last_name" + } +} set context_bar [list [list "." Administration] [list job-history "Mail Job History"] "Show"] 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-oracle.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-oracle.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -8,9 +8,8 @@ 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 + from ml_mail_jobs j + where j.package_id = :package_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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-postgresql.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-pending-postgresql.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -8,9 +8,8 @@ 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 + from ml_mail_jobs j + where j.package_id = :package_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-preview.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp,v diff -u -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -45,5 +45,5 @@ - + 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/job-preview.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -105,7 +105,7 @@ # 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] + set valid_vars [list user_id user_first_names user_last_name user_email link view_mail_link] } else { # get sql-query if {![db_0or1row get_mail_job_sql_query {}]} { @@ -118,6 +118,7 @@ # 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] + lappend valid_vars link view_mail_link } # check text if all used variables are valid @@ -139,11 +140,18 @@ # 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]} {} } + if {![empty_string_p $mail_html_body]} { + # we have to use noquote-substitution for mail view tracking in html mails + while {[regsub -all -nocase {@view_mail_link@} $mail_html_body {@view_mail_link;noquote@} mail_html_body]} {} + while {[regsub -all -nocase {]*?>} $mail_html_body {} mail_html_body]} {} + } set user_first_names "Joe" set user_last_name "User" set user_id 999 set user_email "joe.user@hotmail.com" + set link "[ad_url][ad_conn package_url]?user_id=$user_id&x=some_x_test" + set view_mail_link "" variable ::template::parse_level lappend ::template::parse_level [info level] 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/jobs.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -8,6 +8,8 @@ bind_var:array,optional } +ns_log notice "$list_id" + 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 @@ -77,7 +79,7 @@ {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] + set allowed_variables [list user_id user_first_names user_last_name user_email link view_mail_link] } else { # spamming an user-selection ad_form -extend -name mail_job_form -form { @@ -106,6 +108,7 @@ set query_string [db_bind_var_substitution $query_string $subs_list] } set allowed_variables [user_selection::get_field_names -query $query_string] + lappend allowed_variables link view_mail_link } ad_form -extend -name mail_job_form -form { 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -1,102 +1,116 @@ -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 +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, first names and last names as a list (csv)"}} + {emails:text(textarea) {label "Emails"} {html {rows 30 cols 80}}} + {confirmation_p:text(checkbox),optional {label "Send confirmation?"} {options {{"Yes" t}}}} + {no_emails_p:text(checkbox),optional {label "Suppress all emails?"} {options {{"Yes" t}}}} +} -validate { + {emails { + [empty_string_p [set invalid_list [mailing_list::util::check_valid_emails -emails $emails]]]} + "Invalid emails: [join $invalid_list , ]"} +} -on_submit { + permission::require_permission -object_id $list_id -privilege read + + if {[exists_and_not_null no_emails_p]} { + set no_emails_p t + set confirmed_p t + } else { + set no_emails_p f + if {[exists_and_not_null confirmation_p]} { + set confirmed_p f + } else { + set confirmed_p t + } + } + + set default_first_names "first_names" + set default_last_name "last_name" + + db_1row get_list_mail_data {} + + # generate tmp-file for csv-processing + set tmp_file [ns_tmpnam] + set fd [open $tmp_file w] + puts $fd $emails + close $fd + set fd [open $tmp_file r] + + set unsubscribe_link "[ad_url][ad_conn package_url]" + + db_transaction { + # process every line of the email list + while {[ns_getcsv $fd line] > 0} { + + set user_id "" + # grap the email of the current line + util_unlist $line email user_first_names user_last_name + if {[empty_string_p "$user_first_names$user_last_name"]} { + set user_first_names $default_first_names + set user_last_name $default_last_name + } + + # check if user already exists + set user_id [db_string get_user_id {} -default ""] + + if {[empty_string_p $user_id]} { + # user doesn't exist, so create him + set user_password [ad_generate_random_string] + set user_id [db_nextval acs_object_id_seq] + + array set creation_info [auth::create_user \ + -user_id $user_id \ + -email $email \ + -first_names $user_first_names \ + -last_name $user_last_name \ + -password $user_password \ + -email_verified_p $confirmed_p] + + if {$creation_info(creation_status) != "ok"} { + # something went wrong during user creation + ns_log notice "list-subscribe: could not create user $email: $creation_info(element_messages)" + } + array unset creation_info + } else { + set user_password "" + } + + set confirmation_link "[ad_url][ad_conn package_url]confirm?[export_url_vars list_id user_id]" + + # 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]} { + if {$no_emails_p == "f"} { + # 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/list-subscribe.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -14,12 +14,13 @@ - + - select country_code, category_id - from ml_country_codes - + select party_id + from parties + where email = lower(:email) + 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-all-region.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -1,60 +1,42 @@ ad_page_contract { - Show all clicks on a link from a given mail job , brocken down by Region and Country within Region. - - + Show all clicks on a link from a given mail job, broken 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}]} { +if {![db_0or1row get_current_country_category_tree {}]} { # 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] - } + 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 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.adp 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.adp 21 Jan 2004 19:22:15 -0000 1.2 @@ -1,27 +1,27 @@ -Administer Country Codes +Weekly Mail Link Clicks @context_bar;noquote@

          @pretty_week_date@

          - -<%=$image_map%> + +@image_map;noquote@ - + - +
          Move one Week
          Move one Week
          - << Backward + << Backward No Previous Week. - Forward >> + Forward >> No further Week! @@ -33,4 +33,4 @@

          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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.tcl 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.tcl 21 Jan 2004 19:22:15 -0000 1.2 @@ -3,9 +3,6 @@ @cvs-id $Id$ } { - - - date:optional {adp_list_name "GENERAL"} sel_month:optional @@ -25,32 +22,22 @@ 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}]} { +if {![db_0or1row get_current_country_category_tree {}]} { # 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]} { @@ -60,42 +47,24 @@ # 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} { + db_foreach get_first_date {} { + if {$count == 0} { set date $cur_date set date_first $cur_date incr count - } - - - } if_no_rows {dates_available "false"} + } + } if_no_rows {set dates_available "false"} - if {$dates_available == true} { - + 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 @@ -106,7 +75,7 @@ db_foreach get_category_ids_for_region {} { - set regions_array($cur_category_id) [category::get_name $cur_category_id] + 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] @@ -122,13 +91,6 @@ ### 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] @@ -170,10 +132,7 @@ 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 @@ -182,30 +141,19 @@ 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 "" + switch $i { + 1 {lappend bar_chart_lables "Sunday"} + 25 {lappend bar_chart_lables "Monday"} + 49 {lappend bar_chart_lables "Tuesday"} + 73 {lappend bar_chart_lables "Wednesday"} + 97 {lappend bar_chart_lables "Thursday"} + 121 {lappend bar_chart_lables "Friday"} + 145 {lappend bar_chart_lables "Saturday"} + + default {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. @@ -215,21 +163,11 @@ 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. @@ -255,50 +193,42 @@ 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] +regsub -all {index[0-9]+} $image_map "" image_map +regsub -all {href=\"test\?stats-lists-nopage\"} $image_map "" image_map # 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 {$count == 0} { + set date_first $cur_date + incr count + } + } if_no_rows {set dates_available "false"} } -if {$dates_available == true} { +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} { @@ -318,14 +248,4 @@ } } - - - - - - - - - - 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 -r1.1 -r1.2 --- openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.xql 1 Oct 2003 05:01:55 -0000 1.1 +++ openacs-4/contrib/packages/mailing-lists/www/madmin/stats-weekly.xql 21 Jan 2004 19:22:15 -0000 1.2 @@ -1,20 +1,31 @@ + + + + select tree_id + from ml_country_category_tree + where package_id = :mailing_list_package_id + + + + + - select count(*) as number_clicks, to_char(l.click_time,'J') as cur_date, - p.category_id + 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 + group by cur_date, p.category_id + order by cur_date, p.category_id @@ -23,31 +34,13 @@ - SELECT category_id as cur_category_id FROM categories WHERE tree_id = :tree_id AND parent_id is null + 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 - - - - -