Index: openacs-4/packages/contacts/contacts.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/contacts.info,v diff -u -N -r1.75 -r1.76 --- openacs-4/packages/contacts/contacts.info 28 May 2006 01:50:20 -0000 1.75 +++ openacs-4/packages/contacts/contacts.info 2 Jun 2006 09:18:30 -0000 1.76 @@ -7,14 +7,14 @@ f f - + Matthew Geddert This application lets you collaboratively view, edit and categorize contacts. - 2006-05-27 + 2006-06-02 Contacts is an application for managing all those people and or organization you need to keep track of. It has a complete UI for storing and categorizing contacts. Each contact can have an arbitrary number of custom attributes associated with it, including other contacts (i.e. a certain contact "belongs" to a certain organization). It also functions as a service contract provider for attributes related to users in your system 0 - + @@ -41,6 +41,7 @@ + Index: openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml,v diff -u -N -r1.82 -r1.83 --- openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml 28 May 2006 01:50:21 -0000 1.82 +++ openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml 2 Jun 2006 09:18:30 -0000 1.83 @@ -1,5 +1,5 @@ - + -- select a group -- -- add column -- @@ -91,6 +91,7 @@ Clear Clear the currently selected Category Clear the currently selected Search + Closed down or deceased Comment Added Comments Complaint @@ -151,6 +152,9 @@ Description: A short description of what the subquery does. Details + Do not email + Do not mail + Do not phone does not contain -> does not exist Done @@ -162,6 +166,8 @@ Email EMail Email Address + emailing allowed + emailing not allowed Employee Employees employees @@ -200,8 +206,10 @@ Group Name Groups groups + has closed down or is deceased has logged in has never logged in + has not closed down and is not deceased Header Help Text History @@ -441,6 +449,8 @@ Mail Merge Mail Merge Results Mail to contact + mailing allowed + mailing not allowed Make Current Make Public Make the checked contacts current @@ -505,13 +515,16 @@ Person person Person Form + phoning allowed + phoning not allowed Please choose a contact pp. Pretty Name The Pretty Name to use in the list label. Preview Print Print Letter + Privacy Settings Processes PROJECT Project: @@ -613,6 +626,8 @@ The selected relationship requires that the related contact be an organization The selected relationship requires that the related contact be a person This contact doesn't have an email, you are going to use it's employer email (%emp_addr%) + This organization has closed down + This person is deceased This "Variable Name" is already present times Title Index: openacs-4/packages/contacts/lib/contact-privacy.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/lib/contact-privacy.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/contacts/lib/contact-privacy.adp 2 Jun 2006 09:18:30 -0000 1.1 @@ -0,0 +1,13 @@ + + +

#contacts.This_organization_has_closed_down#

+
+ +

#contacts.This_person_is_deceased#

+
+
+ +

#contacts.Do_not_email#

+

#contacts.Do_not_mail#

+

#contacts.Do_not_phone#

+
Index: openacs-4/packages/contacts/lib/contact-privacy.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/lib/contact-privacy.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/contacts/lib/contact-privacy.tcl 2 Jun 2006 09:18:30 -0000 1.1 @@ -0,0 +1,30 @@ +# packages/contacts/lib/contact-attributes.tcl +# +# Include for the contact attributes +# +# @author Malte Sussdorff (sussdorff@sussdorff.de) +# @creation-date 2005-06-21 +# @arch-tag: 1df33468-0ff5-44e2-874a-5eec78747b8c +# @cvs-id $Id: contact-privacy.tcl,v 1.1 2006/06/02 09:18:30 matthewg Exp $ + +foreach required_param {party_id} { + if {![info exists $required_param]} { + return -code error "$required_param is a required parameter." + } +} + +if { ![exists_and_not_null package_id] } { + set package_id [ad_conn package_id] +} + +set email_p 1 +set mail_p 1 +set phone_p 1 +set gone_p 0 +if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + db_0or1row select_privacy_settings " select * from contact_privacy where party_id = :party_id " + if { [string is true $gone_p] } { + set object_type [util_memoize [list acs_object_type $party_id]] + } +} + Index: openacs-4/packages/contacts/sql/postgresql/contacts-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/sql/postgresql/contacts-create.sql,v diff -u -N -r1.12 -r1.13 --- openacs-4/packages/contacts/sql/postgresql/contacts-create.sql 12 Mar 2006 09:36:35 -0000 1.12 +++ openacs-4/packages/contacts/sql/postgresql/contacts-create.sql 2 Jun 2006 09:18:30 -0000 1.13 @@ -151,9 +151,35 @@ unique(party_id,object_id) ); --- create the content type +-- Table that allows you to control the privacy of +-- a contact. This prevents you from contacting a +-- contact in a way the that is not liked if enabled +-- via a parameter +create table contact_privacy ( + party_id integer primary key + constraint contact_privacy_party_id_fk references parties(party_id) on delete cascade, + email_p boolean not null default 't', + mail_p boolean not null default 't', + phone_p boolean not null default 't', + gone_p boolean not null default 'f' -- if a person is deceased or an organization is closed down + constraint contact_privacy_gone_p_ck check ( + ( gone_p is TRUE AND ( mail_p is FALSE and email_p is FALSE and phone_p is FALSE )) + or ( gone_p is FALSE ) + ) +); +-- pre populate the contact_privacy table with +-- all of the parties already in the system +insert into contact_privacy +( party_id, email_p, mail_p, phone_p, gone_p ) +select party_id, 't'::boolean, 't'::boolean, 't'::boolean, 'f'::boolean + from parties + where party_id not in ( select party_id from contact_privacy ) + order by party_id; + + + \i contacts-package-create.sql \i contacts-search-create.sql \i contacts-messages-create.sql Index: openacs-4/packages/contacts/sql/postgresql/contacts-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/sql/postgresql/contacts-drop.sql,v diff -u -N -r1.8 -r1.9 --- openacs-4/packages/contacts/sql/postgresql/contacts-drop.sql 30 May 2006 06:21:10 -0000 1.8 +++ openacs-4/packages/contacts/sql/postgresql/contacts-drop.sql 2 Jun 2006 09:18:30 -0000 1.9 @@ -6,6 +6,7 @@ -- -- +drop table contact_privacy; drop table contact_message_log; drop table contact_message_items; drop table contact_message_types; @@ -36,4 +37,4 @@ select drop_package('contact_rel'); select drop_package('contact_party_revision'); -drop sequence contact_extend_search_seq; \ No newline at end of file +drop sequence contact_extend_search_seq; Index: openacs-4/packages/contacts/sql/postgresql/upgrade/upgrade-1.2b13-1.2b14.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/sql/postgresql/upgrade/upgrade-1.2b13-1.2b14.sql,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/contacts/sql/postgresql/upgrade/upgrade-1.2b13-1.2b14.sql 2 Jun 2006 09:18:30 -0000 1.1 @@ -0,0 +1,29 @@ +-- +-- packages/contacts/sql/postgresql/upgrade/upgrade-1.2d13-1.2d14.sql +-- +-- @author Matthew Geddert (openacs@geddert.com) +-- @creation-date 2005-06-01 +-- @arch-tag: +-- @cvs-id $Id: upgrade-1.2b13-1.2b14.sql,v 1.1 2006/06/02 09:18:30 matthewg Exp $ +-- + +create table contact_privacy ( + party_id integer primary key + constraint contact_privacy_party_id_fk references parties(party_id) on delete cascade, + email_p boolean not null default 't', + mail_p boolean not null default 't', + phone_p boolean not null default 't', + gone_p boolean not null default 'f' -- if a person is deceased or an organization is closed down + constraint contact_privacy_gone_p_ck check ( + ( gone_p is TRUE AND ( mail_p is FALSE and email_p is FALSE and phone_p is FALSE )) + or ( gone_p is FALSE ) + ) +); + +insert into contact_privacy +( party_id, email_p, mail_p, phone_p, gone_p ) +select party_id, 't'::boolean, 't'::boolean, 't'::boolean, 'f'::boolean + from parties + where party_id not in ( select party_id from contact_privacy ) + order by party_id; + Index: openacs-4/packages/contacts/tcl/contact-message-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contact-message-procs.tcl,v diff -u -N -r1.30 -r1.31 --- openacs-4/packages/contacts/tcl/contact-message-procs.tcl 21 May 2006 00:42:26 -0000 1.30 +++ openacs-4/packages/contacts/tcl/contact-message-procs.tcl 2 Jun 2006 09:18:31 -0000 1.31 @@ -157,33 +157,44 @@ ad_proc -private contact::message::email_address_exists_p { {-party_id:required} {-package_id ""} + {-override_privacy_p "f"} } { Does a message email address exist for this party or his/her employer. Cached via contact::message::email_address. } { if { $package_id eq "" } { set package_id [ad_conn package_id] } - return [string is false [empty_string_p [contact::message::email_address -party_id $party_id -package_id [ad_conn package_id]]]] + return [string is false [empty_string_p [contact::message::email_address -party_id $party_id -package_id $package_id -override_privacy_p $override_privacy_p]]] } ad_proc -private contact::message::email_address { {-party_id:required} {-package_id ""} + {-override_privacy_p "f"} } { Does a message email address exist for this party + + @param override_privacy_p override the privacy contacts settings to force the information to be returned if it exists } { if { $package_id eq "" } { set package_id [ad_conn package_id] } - return [util_memoize [list ::contact::message::email_address_not_cached -party_id $party_id -package_id $package_id]] + return [util_memoize [list ::contact::message::email_address_not_cached -party_id $party_id -package_id $package_id -override_privacy_p $override_privacy_p]] } ad_proc -private contact::message::email_address_not_cached { {-party_id:required} {-package_id:required} + {-override_privacy_p:required} } { Does a message email address exist for this party + } { + if { [string is false $override_privacy_p] } { + if { [contact::privacy_prevents_p -party_id $party_id -package_id $package_id -type "email"] } { + return {} + } + } set email [contact::email -party_id $party_id] if { $email eq "" } { # if this person is the employee of @@ -202,6 +213,7 @@ ad_proc -private contact::message::mailing_address_exists_p { {-party_id:required} {-package_id ""} + {-override_privacy_p "f"} } { Does a mailing address exist for this party. Cached via contact::message::mailing_address. } { @@ -214,15 +226,19 @@ # this simplifies the code and thus "pre" caches the address # for the user, which overall is faster - return [string is false [empty_string_p [contact::message::mailing_address -party_id $party_id -format "text" -package_id $package_id]]] + return [string is false [empty_string_p [contact::message::mailing_address -party_id $party_id -format "text" -package_id $package_id -override_privacy_p $override_privacy_p]]] } ad_proc -private contact::message::mailing_address { {-party_id:required} {-format "text/plain"} {-package_id ""} + {-override_privacy_p "f"} } { Returns a parties mailing address. Cached + + @param override_privacy_p override the privacy contacts settings to force the information to be returned if it exists + } { regsub -all "text/" $format "" format if { $format != "html" } { @@ -231,16 +247,22 @@ if { $package_id eq "" } { set package_id [ad_conn package_id] } - return [util_memoize [list ::contact::message::mailing_address_not_cached -party_id $party_id -format $format -package_id $package_id]] + return [util_memoize [list ::contact::message::mailing_address_not_cached -party_id $party_id -format $format -package_id $package_id -override_privacy_p $override_privacy_p]] } ad_proc -private contact::message::mailing_address_not_cached { {-party_id:required} {-format:required} {-package_id:required} + {-override_privacy_p:required} } { Returns a parties mailing address } { + if { [string is false $override_privacy_p] } { + if { [contact::privacy_prevents_p -party_id $party_id -package_id $package_id -type "mail"] } { + return {} + } + } set attribute_ids [contact::message::mailing_address_attribute_id_priority -package_id $package_id] set revision_id [contact::live_revision -party_id $party_id] set mailing_address {} @@ -258,7 +280,7 @@ # an organization we can attempt to use # that organizations email address foreach employer [contact::util::get_employers -employee_id $party_id -package_id $package_id] { - set mailing_address [contact::message::mailing_address -party_id [lindex $employer 0] -package_id $package_id] + set mailing_address [contact::message::mailing_address -party_id [lindex $employer 0] -package_id $package_id -override_privacy_p $override_privacy_p] if { $mailing_address ne "" } { break } Index: openacs-4/packages/contacts/tcl/contact-search-condition-type-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contact-search-condition-type-procs.tcl,v diff -u -N -r1.31 -r1.32 --- openacs-4/packages/contacts/tcl/contact-search-condition-type-procs.tcl 22 May 2006 22:29:50 -0000 1.31 +++ openacs-4/packages/contacts/tcl/contact-search-condition-type-procs.tcl 2 Jun 2006 09:18:31 -0000 1.32 @@ -571,26 +571,41 @@ ad_form_widgets { set form_elements [list] - set contact_options [list \ - [list "[_ contacts.in_the_search] ->" "in_search"] \ - [list "[_ contacts.not_in_the_search] ->" "not_in_search"] \ - [list "[_ contacts.lt_updated_in_the_last_-]" "update"] \ - [list "[_ contacts.lt_not_updated_in_the_la]" "not_update"] \ - [list "[_ contacts.lt_interacted_in_the_last_-]" "interacted"] \ - [list "[_ contacts.lt_not_interacted_in_the_la]" "not_interacted"] \ - [list "[_ contacts.lt_interacted_between_-]" "interacted_between"] \ - [list "[_ contacts.lt_not_interacted_betwe]" "not_interacted_between"] \ - [list "[_ contacts.lt_commented_on_in_last_]" "comment"] \ - [list "[_ contacts.lt_not_commented_on_in_l]" "not_comment"] \ - [list "[_ contacts.lt_created_in_the_last_-]" "created"] \ - [list "[_ contacts.lt_not_created_in_the_la]" "not_created"] \ - ] + + set contact_options [list] + lappend contact_options [list "[_ contacts.in_the_search] ->" "in_search"] + lappend contact_options [list "[_ contacts.not_in_the_search] ->" "not_in_search"] + + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + lappend contact_options [list "[_ contacts.has_closed_down_or_is_deceased]" "privacy_gone_true"] + lappend contact_options [list "[_ contacts.has_not_closed_down_and_is_not_deceased]" "privacy_gone_false"] + lappend contact_options [list "[_ contacts.emailing_not_allowed]" "privacy_email_false"] + lappend contact_options [list "[_ contacts.emailing_allowed]" "privacy_email_true"] + lappend contact_options [list "[_ contacts.mailing_not_allowed]" "privacy_mail_false"] + lappend contact_options [list "[_ contacts.mailing_allowed]" "privacy_mail_true"] + lappend contact_options [list "[_ contacts.phoning_not_allowed]" "privacy_phone_false"] + lappend contact_options [list "[_ contacts.phoning_allowed]" "privacy_phone_true"] + + } + + lappend contact_options [list "[_ contacts.lt_updated_in_the_last_-]" "update"] + lappend contact_options [list "[_ contacts.lt_not_updated_in_the_la]" "not_update"] + lappend contact_options [list "[_ contacts.lt_interacted_in_the_last_-]" "interacted"] + lappend contact_options [list "[_ contacts.lt_not_interacted_in_the_la]" "not_interacted"] + lappend contact_options [list "[_ contacts.lt_interacted_between_-]" "interacted_between"] + lappend contact_options [list "[_ contacts.lt_not_interacted_betwe]" "not_interacted_between"] + lappend contact_options [list "[_ contacts.lt_commented_on_in_last_]" "comment"] + lappend contact_options [list "[_ contacts.lt_not_commented_on_in_l]" "not_comment"] + lappend contact_options [list "[_ contacts.lt_created_in_the_last_-]" "created"] + lappend contact_options [list "[_ contacts.lt_not_created_in_the_la]" "not_created"] + if { $object_type == "person" } { lappend contact_options [list "[_ contacts.has_logged_in]" "login"] lappend contact_options [list "[_ contacts.has_never_logged_in]" "not_login"] lappend contact_options [list "[_ contacts.lt_has_logged_in_within_]" "login_time"] lappend contact_options [list "[_ contacts.lt_has_not_logged_in_wit]" "not_login_time"] } + lappend form_elements [list \ ${prefix}operand:text(select) \ [list label {}] \ @@ -630,7 +645,7 @@ } elseif { [lsearch [list interacted_between not_interacted_between] ${operand}] >= 0 } { lappend form_elements [list ${var1}:textdate [list label {}] [list after_html "and"]] lappend form_elements [list ${var2}:textdate [list label {}]] - } else { + } elseif { [lsearch [list privacy_gone_true privacy_gone_false privacy_email_true privacy_email_false privacy_mail_true privacy_mail_false privacy_phone_true privacy_phone_false] ${operand}] < 0 } { set interval_options [list \ [list days days] \ [list months months] \ @@ -647,6 +662,9 @@ login - not_login { return [set ${operand}] } + privacy_gone_true - privacy_gone_false - privacy_email_true - privacy_email_false - privacy_mail_true - privacy_mail_false - privacy_phone_true - privacy_phone_false { + return ${operand} + } in_search - not_in_search { if { [exists_and_not_null ${var1}] } { return [list ${operand} [set ${var1}]] @@ -758,6 +776,43 @@ set output_pretty "[_ contacts.lt_Contact_has_not_logge]" set output_code "CASE WHEN ( select last_visit from users where user_id = $party_id ) > ( now() - '$interval'::interval ) THEN 'f'::boolean ELSE 't'::boolean END" } + privacy_gone_true - privacy_gone_false - privacy_email_true - privacy_email_false - privacy_mail_true - privacy_mail_false - privacy_phone_true - privacy_phone_false { + switch ${operand} { + privacy_gone_true { + set output_pretty [_ contacts.has_closed_down_or_is_deceased] + set condition "gone_p is true" + } + privacy_gone_false { + set output_pretty [_ contacts.has_not_closed_down_and_is_not_deceased] + set condition "gone_p is false" + } + privacy_email_false { + set output_pretty [_ contacts.emailing_not_allowed] + set condition "email_p is false" + } + privacy_email_true { + set output_pretty [_ contacts.emailing_allowed] + set condition "email_p is true" + } + privacy_mail_false { + set output_pretty [_ contacts.mailing_not_allowed] + set condition "mail_p is false" + } + privacy_mail_true { + set output_pretty [_ contacts.mailing_allowed] + set condition "mail_p is true" + } + privacy_phone_false { + set output_pretty [_ contacts.phoning_not_allowed] + set condition "phone_p is false" + } + privacy_phone_true { + set output_pretty [_ contacts.phoning_allowed] + set condition "phone_p is true" + } + } + set output_code "${party_id} in ( select party_id from contact_privacy where $condition )" + } } if { $request == "pretty" } { return $output_pretty Index: openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl,v diff -u -N -r1.44 -r1.45 --- openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl 29 May 2006 21:50:18 -0000 1.44 +++ openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl 2 Jun 2006 09:18:31 -0000 1.45 @@ -839,7 +839,7 @@ } } -ad_proc -public -callback contacts::multirow::extend -impl relationships { +ad_proc -public -callback contacts::multirow::extend -impl groups { {-type} {-key} {-select_query} @@ -893,6 +893,50 @@ } } +ad_proc -public -callback contacts::multirow::extend -impl privacy { + {-type} + {-key} + {-select_query} + {-format "html"} +} { +} { + set results [list] + if { $type eq "privacy" } { + set true [_ contacts.True] + set false [_ contacts.False] + db_foreach get_group_members " + select party_id, + $key as permission_p + from contact_privacy + where party_id in ( $select_query ) + " { + if { $permission_p } { + lappend results $party_id $false + } else { + lappend results $party_id $true + } + } + } + return $results +} + + +ad_proc -public -callback contacts::extensions -impl privacy { + {-multirow} + {-user_id} + {-package_id} + {-object_type} +} { +} { + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + set pretty_group [_ contacts.Privacy_Settings] + template::multirow append $multirow privacy privacy $pretty_group gone_p [_ contacts.Closed_down_or_deceased] + template::multirow append $multirow privacy privacy $pretty_group email_p [_ contacts.Do_not_email] + template::multirow append $multirow privacy privacy $pretty_group mail_p [_ contacts.Do_not_mail] + template::multirow append $multirow privacy privacy $pretty_group phone_p [_ contacts.Do_not_phone] + } +} + ad_proc -public -callback contacts::redirect -impl contactspdfs { {-party_id ""} {-action ""} @@ -952,6 +996,19 @@ set spouse_link [contact::link -party_id $spouse_id] util_user_message -html -message [_ contacts.lt_spouse_spouse_link_was_updated] + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + # we copy privacy settings from the most recently edited contact, i.e. party_id + # UNLESS this person is deceased + if { [db_0or1row get_info { select * from contact_privacy where party_id = :party_id and gone_p is false }] } { + db_dml update_privacy { update contact_privacy + set email_p = :email_p, + mail_p = :mail_p, + phone_p = :phone_p + where party_id = :party_id + and gone_p is false } + } + } + contact::flush -party_id $spouse_id contact::search::flush_results_counts Index: openacs-4/packages/contacts/tcl/contacts-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-init.tcl,v diff -u -N -r1.11 -r1.12 --- openacs-4/packages/contacts/tcl/contacts-init.tcl 15 Mar 2006 23:04:53 -0000 1.11 +++ openacs-4/packages/contacts/tcl/contacts-init.tcl 2 Jun 2006 09:18:31 -0000 1.12 @@ -11,9 +11,9 @@ # accounts for themselves) content_items and content_revisions # are automatically create. This is needed for contacts # searches to work correctly. -ad_schedule_proc -thread t 300 contacts::create_revisions_sweeper +ad_schedule_proc -thread t 300 contacts::sweeper # we also run it once now -contacts::create_revisions_sweeper +contacts::sweeper Index: openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql,v diff -u -N -r1.18 -r1.19 --- openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql 28 May 2006 01:50:21 -0000 1.18 +++ openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql 2 Jun 2006 09:18:31 -0000 1.19 @@ -26,22 +26,32 @@ - + select person_id from persons where person_id not in ( select item_id from cr_items ) - + select organization_id from organizations where organization_id not in ( select item_id from cr_items ) + + + insert into contact_privacy + ( party_id, nomail_p, noemail_p, nophone_p, gone_p ) + select party_id, 'f'::boolean, 'f'::boolean, 'f'::boolean, 'f'::boolean + from parties + where party_id not in ( select party_id from contact_privacy ) + + + select attribute_id @@ -60,6 +70,42 @@ + + + select ${type}_p + from contact_privacy + where party_id = :party_id + + + + + + select 1 + from contact_privacy + where party_id = :party_id + + + + + + update contact_privacy + set email_p = :email_p, + mail_p = :mail_p, + phone_p = :phone_p, + gone_p = :gone_p + where party_id = :party_id + + + + + + insert into contact_privacy + ( party_id, email_p, mail_p, phone_p, gone_p ) + values + ( :party_id, :email_p, :mail_p, :phone_p, :gone_p ) + + + select name Index: openacs-4/packages/contacts/tcl/contacts-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-procs.tcl,v diff -u -N -r1.88 -r1.89 --- openacs-4/packages/contacts/tcl/contacts-procs.tcl 31 May 2006 17:13:29 -0000 1.88 +++ openacs-4/packages/contacts/tcl/contacts-procs.tcl 2 Jun 2006 09:18:31 -0000 1.89 @@ -81,7 +81,7 @@ } } -ad_proc -private contacts::create_revisions_sweeper { +ad_proc -private contacts::sweeper { } { So that contacts searches work correctly, and quickly every person or organization in the system @@ -93,16 +93,17 @@ associated item_id and live_revisions. } { db_foreach get_persons_without_items {} { - ns_log notice "contacts::create_revisions_sweeper creating content_item and content_revision for party_id: $person_id" + ns_log notice "contacts::sweeper creating content_item and content_revision for party_id: $person_id" contact::revision::new -party_id $person_id } db_foreach get_organizations_without_items {} { - ns_log notice "contacts::create_revisions_sweeper creating content_item and content_revision for organization_id: $organization_id" + ns_log notice "contacts::sweeper creating content_item and content_revision for organization_id: $organization_id" contact::revision::new -party_id $organization_id } if { ![info exists person_id] && ![info exists organization_id] } { - ns_log notice "contacts::create_revisions_sweeper no person or organization objects exist that do not have associated content_items" + ns_log notice "contacts::sweeper no person or organization objects exist that do not have associated content_items" } + db_dml insert_privacy_records {} } ad_proc -public contacts::multirow { @@ -203,6 +204,69 @@ return [db_0or1row rel_type_enabled_p {}] } +ad_proc -public contact::privacy_allows_p { + {-party_id:required} + {-type:required} + {-package_id ""} +} { + @param party_id the party_id to check permission for + @param type either 'email', 'mail' or 'phone' + @returns 1 or 0 if the specified type of communication is allowed +} { + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + if { $package_id eq "" } { + if { [ad_conn package_key] eq "contacts" } { + set package_id [ad_conn package_id] + } else { + error "You must specify a valid contacts package id if your are accessing this procedure from a package other than contacts" + } + } + if { [lsearch [list email mail phone] $type] < 0 } { + error "contact::privacy_allows_p, you specified an invalid type: '${type}' (you must specify, email, mail or phone)" + } + if { [db_string is_type_allowed_p {} -default {1}] } { + return 1 + } else { + return 0 + } + } + # by default permission is allowed + return 1 +} + +ad_proc -public contact::privacy_prevents_p { + {-party_id:required} + {-type:required} + {-package_id ""} +} { + @param party_id the party_id to check permission for + @param type either 'email', 'mail' or 'phone' + @returns 1 or 0 if the specified type of communication is allowed +} { + if { [contact::privacy_allows_p -party_id $party_id -type $type -package_id $package_id] } { + return 0 + } else { + return 1 + } +} + +ad_proc -public contact::privacy_set { + {-party_id:required} + {-email_p:required} + {-mail_p:required} + {-phone_p:required} + {-gone_p:required} +} { +} { + db_transaction { + if { [db_0or1row record_exists_p {}] } { + db_dml update_privacy {} + } else { + db_dml insert_privacy {} + } + } +} + ad_proc -private contact::util::generate_filename { {-title:required} {-extension:required} Index: openacs-4/packages/contacts/www/contact-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/contact-add.tcl,v diff -u -N -r1.48 -r1.49 --- openacs-4/packages/contacts/www/contact-add.tcl 21 May 2006 00:43:42 -0000 1.48 +++ openacs-4/packages/contacts/www/contact-add.tcl 2 Jun 2006 09:18:31 -0000 1.49 @@ -100,6 +100,26 @@ -object_type $object_type \ -list_names $list_names] + +if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + set privacy_setting_options [list] + if { $object_type eq "organization" } { + lappend privacy_setting_options [list [_ contacts.This_organization_has_closed_down] gone_p] + } else { + lappend privacy_setting_options [list [_ contacts.This_person_is_deceased] gone_p] + } + lappend privacy_setting_options [list [_ contacts.Do_not_email] email_p] + lappend privacy_setting_options [list [_ contacts.Do_not_mail] mail_p] + lappend privacy_setting_options [list [_ contacts.Do_not_phone] phone_p] + + lappend form_definition [list contact_privacy_settings:boolean(checkbox),multiple,optional \ + [list label [_ contacts.Privacy_Settings]] \ + [list options $privacy_setting_options] \ + ] +} + + + #ad_return_error "$object_type" "$list_names :: $form_definition" # Creating the form @@ -323,6 +343,35 @@ set object_type [_ contacts.$object_type] util_user_message -html -message "[_ contacts.lt_The_-object_type-_-contact_link-_was_added]" + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + set contact_privacy_settings [template::element::get_values party_ae contact_privacy_settings] + set gone_p 0 + set email_p 1 + set mail_p 1 + set phone_p 1 + if { [lsearch $contact_privacy_settings gone_p] >= 0 } { + set gone_p 1 + set email_p 0 + set mail_p 0 + set phone_p 0 + } else { + if { [lsearch $contact_privacy_settings email_p] >= 0 } { + set email_p 0 + } + if { [lsearch $contact_privacy_settings mail_p] >= 0 } { + set mail_p 0 + } + if { [lsearch $contact_privacy_settings phone_p] >= 0 } { + set phone_p 0 + } + } + contact::privacy_set \ + -party_id $party_id \ + -email_p $email_p \ + -mail_p $mail_p \ + -phone_p $phone_p \ + -gone_p $gone_p + } } -after_submit { contact::flush -party_id $party_id Index: openacs-4/packages/contacts/www/contact-edit.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/contact-edit.tcl,v diff -u -N -r1.21 -r1.22 --- openacs-4/packages/contacts/www/contact-edit.tcl 28 May 2006 01:30:28 -0000 1.21 +++ openacs-4/packages/contacts/www/contact-edit.tcl 2 Jun 2006 09:18:31 -0000 1.22 @@ -42,6 +42,24 @@ append form_elements " [ams::ad_form::elements -package_key "contacts" -object_type $object_type -list_names $ams_forms]" + +if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + set privacy_setting_options [list] + if { $object_type eq "organization" } { + lappend privacy_setting_options [list [_ contacts.This_organization_has_closed_down] gone_p] + } else { + lappend privacy_setting_options [list [_ contacts.This_person_is_deceased] gone_p] + } + lappend privacy_setting_options [list [_ contacts.Do_not_email] email_p] + lappend privacy_setting_options [list [_ contacts.Do_not_mail] mail_p] + lappend privacy_setting_options [list [_ contacts.Do_not_phone] phone_p] + + lappend form_elements [list contact_privacy_settings:boolean(checkbox),multiple,optional \ + [list label [_ contacts.Privacy_Settings]] \ + [list options $privacy_setting_options] \ + ] +} + ad_form -name party_ae \ -mode "edit" \ -export {return_url} \ @@ -83,6 +101,13 @@ ad_return_error "[_ contacts.Configuration_Error]" "[_ contacts.lt_Some_of_the_required__1]
  • [join $missing_elements "
  • "]
" } + if { [db_0or1row select_privacy_settings { select * from contact_privacy where party_id = :party_id }] } { + set contact_privacy_settings [list] + if { [string is false $email_p] } { lappend contact_privacy_settings email_p } + if { [string is false $mail_p] } { lappend contact_privacy_settings mail_p } + if { [string is false $phone_p] } { lappend contact_privacy_settings phone_p } + if { [string is true $gone_p] } { lappend contact_privacy_settings gone_p } + } } -edit_request { set revision_id [contact::live_revision -party_id $party_id] foreach form $ams_forms { @@ -188,6 +213,35 @@ } else { callback contact::person_add -package_id $package_id -person_id $party_id } + if { [parameter::get -boolean -package_id $package_id -parameter "ContactPrivacyEnabledP" -default "0"] } { + set contact_privacy_settings [template::element::get_values party_ae contact_privacy_settings] + set gone_p 0 + set email_p 1 + set mail_p 1 + set phone_p 1 + if { [lsearch $contact_privacy_settings gone_p] >= 0 } { + set gone_p 1 + set email_p 0 + set mail_p 0 + set phone_p 0 + } else { + if { [lsearch $contact_privacy_settings email_p] >= 0 } { + set email_p 0 + } + if { [lsearch $contact_privacy_settings mail_p] >= 0 } { + set mail_p 0 + } + if { [lsearch $contact_privacy_settings phone_p] >= 0 } { + set phone_p 0 + } + } + contact::privacy_set \ + -party_id $party_id \ + -email_p $email_p \ + -mail_p $mail_p \ + -phone_p $phone_p \ + -gone_p $gone_p + } } -after_submit { contact::flush -party_id $party_id contact::search::flush_results_counts Index: openacs-4/packages/contacts/www/contact.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/contact.adp,v diff -u -N -r1.42 -r1.43 --- openacs-4/packages/contacts/www/contact.adp 28 Apr 2006 10:15:08 -0000 1.42 +++ openacs-4/packages/contacts/www/contact.adp 2 Jun 2006 09:18:31 -0000 1.43 @@ -2,6 +2,7 @@ @party_id@
+
Index: openacs-4/packages/contacts/www/resources/contacts.css =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/resources/contacts.css,v diff -u -N -r1.13 -r1.14 --- openacs-4/packages/contacts/www/resources/contacts.css 16 Oct 2005 12:47:50 -0000 1.13 +++ openacs-4/packages/contacts/www/resources/contacts.css 2 Jun 2006 09:18:31 -0000 1.14 @@ -363,3 +363,6 @@ .contact-attributes a:hover { text-decoration: underline; } +h3.contact-privacy { + color: #F00; +}