Index: openacs-4/packages/contacts/contacts.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/contacts.info,v
diff -u -r1.74 -r1.75
--- openacs-4/packages/contacts/contacts.info 18 May 2006 18:02:59 -0000 1.74
+++ openacs-4/packages/contacts/contacts.info 28 May 2006 01:50:20 -0000 1.75
@@ -7,14 +7,14 @@
<initial-install-p>f</initial-install-p>
<singleton-p>f</singleton-p>
- <version name="1.2b12" url="http://openacs.org/repository/download/apm/contacts-1.2b12.apm">
+ <version name="1.2b13" url="http://openacs.org/repository/download/apm/contacts-1.2b13.apm">
<owner url="mailto:openacs@geddert.com">Matthew Geddert</owner>
<summary>This application lets you collaboratively view, edit and categorize contacts.</summary>
- <release-date>2006-03-31</release-date>
+ <release-date>2006-05-27</release-date>
<description format="text/plain">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</description>
<maturity>0</maturity>
- <provides url="contacts" version="1.2b12"/>
+ <provides url="contacts" version="1.2b13"/>
<requires url="acs-datetime" version="4.1"/>
<requires url="acs-events" version="0.5d3"/>
<requires url="acs-tcl" version="5.2.0b3"/>
@@ -26,8 +26,8 @@
<callbacks>
<callback type="after-install" proc="contacts::install::package_install"/>
- <callback type="after-upgrade" proc="contacts::install::package_upgrade"/>
<callback type="after-instantiate" proc="contacts::install::package_instantiate"/>
+ <callback type="after-upgrade" proc="contacts::install::package_upgrade"/>
</callbacks>
<parameters>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="AcceptableFileUploadMIMETypes" default="*" description="* for any. CSV of acceptable MIME Types for File Upload" section_name="File Upload"/>
@@ -70,10 +70,11 @@
<parameter datatype="string" min_n_values="1" max_n_values="1" name="MailingAddressAttributeIdOrder" description="A list of attribute_ids for postal addresses in order of priority. In doing a letter mail merge the first attribute_id in this list that a contact has a value for will be used as the mailing address. If no attribute_ids are specified all postal_address attribute_ids will be used in alphabetical order."/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="Message" default="/packages/contacts/templates/message" description="The template src for the message page" section_name="Portal Templates"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="OOMailingPath" default="/packages//contacts/templates/oo-mailing" description="The directory that contains all files needed for a proper OO mailing. This is the document.odt, content.xml, styles.xml and the banner directory" section_name="Templates"/>
- <parameter datatype="string" min_n_values="1" max_n_values="1" name="PdfJoinBin" default="/usr/bin/pdfjoin" description="Absolute path from computer root to directory containing pdfjoin executables" section_name=""/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="PdfJoinBin" default="/usr/bin/pdfjoin" description="Absolute path from computer root to directory containing pdfjoin executables"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="PortraitSize" default="200x200" description="Max dimensions for portrait" section_name="Photos"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="PortraitThumbnailSize" default="50x50" description="Max dimensions of portrait thumbnail" section_name="Photos"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="RequireAdminForTemplatesP" default="0" description="Do we allow users to create templates in the system. If set to 1, only admins can create templates." section_name="Templates"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SpouseSyncedAttributes" description="A tcl list of a person or party object types attribute_names or attribute_ids that you want people in a spousal relationship to keep in sync. For example, if you change a wife's home_phone and home_address you might want it to automatically update the husband's record as well you could put in 'home_phone home_address', or you might possibly want last_names to stay in sync (depending on cultural context), etc."/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="SquareThumbnails" default="1" description="0 for no, 1 for yes. If yes we crop either the top or the bottom of the image to create square thumbnails and portraits" section_name="Photos"/>
<parameter datatype="string" min_n_values="1" max_n_values="1" name="ThumbnailSize" default="125x125" description="Max dimension for thumbnail image" section_name="Photos"/>
<parameter datatype="number" min_n_values="1" max_n_values="1" name="UseSubsiteAsDefaultGroup" default="0" description="Default '0'. Should we use this contact's instances subsite's application group as the default group? If yes set to '1'. Using the subsites application group as the default group will automatically add all subsite users to this contacts instance. This should only be changed at install time."/>
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 -r1.81 -r1.82
--- openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml 19 May 2006 09:38:46 -0000 1.81
+++ openacs-4/packages/contacts/catalog/contacts.en_US.ISO-8859-1.xml 28 May 2006 01:50:21 -0000 1.82
@@ -1,5 +1,5 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
-<message_catalog package_key="contacts" package_version="1.2b12" locale="en_US" charset="ISO-8859-1">
+<message_catalog package_key="contacts" package_version="1.2b13" locale="en_US" charset="ISO-8859-1">
<msg key="--_select_a_group_--">-- select a group --</msg>
<msg key="--add_column--">-- add column --</msg>
@@ -288,6 +288,7 @@
<msg key="lt_Contact_has_not_logge">Contact has not logged in within the last: <strong>%interval%</strong></msg>
<msg key="lt_Contact_in_the_search_search_link">in the search %search_link%</msg>
<msg key="lt_Contact_interacted_in_th">Contact last interaction in the last: <strong>%interval%</strong></msg>
+ <msg key="lt_contact_link_was_updated">%contact_link% was updated</msg>
<msg key="lt_Contact_not_commented">Contact not commented on in the last: <strong>%interval%</strong></msg>
<msg key="lt_Contact_not_created_i">Contact not created in the last: <strong>%interval%</strong></msg>
<msg key="lt_Contact_not_interacted_i">Contact last interaction not in the last: <strong>%interval%</strong></msg>
@@ -334,6 +335,7 @@
<msg key="lt_li_The_role_you_enter"><li> The role you entered \"%pretty_name%\" or the plural \"%pretty_plural%\" already exists.</msg>
<msg key="lt_Make_sure_you_do_not_">Make sure you do not add the same attribute to multiple groups</msg>
<msg key="lt_neither_person_nor_or">neither person nor org type is valid, what happened admin?</msg>
+ <msg key="lt_No_marrying_yourself">You cannot be married to yourself. Please correct this problem.</msg>
<msg key="lt_no_matches_for_-query-">No matches for '%query%'</msg>
<msg key="lt_No_perm_to_delete_from_hist">You do not have permission to delete this item from this contacts history </msg>
<msg key="lt_not_commented_on_in_l">not commented on in last -></msg>
@@ -358,13 +360,16 @@
<msg key="lt_Remove_from_this_Grou">Remove from this Group</msg>
<msg key="lt_Remove_others_of_this_role_from_these_contacts">Remove all other relationships of this type for these contacts</msg>
<msg key="lt_Remove_others_of_this_role_from_this_related_contact">Remove all other relationships of this type for the related contact</msg>
+ <msg key="lt_Removing_spouse_name_as_spouse">%spouse_name% was automatically removed as a spouse</msg>
<msg key="lt_role_exists">%role% exists</msg>
<msg key="lt_role_in_the_search_search_link">%role% in the search %search_link%</msg>
<msg key="lt_role_not_in_the_search_search_link">%role% not in the search %search_link%</msg>
<msg key="lt_Search_again_over_50_orgs">Search again - over 50 organizations found...</msg>
<msg key="lt_Search_again_over_50_people">Search again - over 50 people found...</msg>
+ <msg key="lt_Select_spouse_value_in_sync">Select the appropriate values for both of these contacts.</msg>
<msg key="lt_Some_of_the_required_">Some of the required elements for this form are missing. Please contact an administrator and make sure that the following attributes are included in the default group's form for this object type:</msg>
<msg key="lt_Some_of_the_required__1">Some of the required elements for this form are missing. Please contact an administrator and make sure that the following attributes are included:</msg>
+ <msg key="lt_spouse_spouse_link_was_updated">Spouse %spouse_link% was updated</msg>
<msg key="lt_stateprovince_is_not_">state/province is not -></msg>
<msg key="lt_The_-object_type-_-contact_link-_was_added">The object type %contact_link% was added</msg>
<msg key="lt_the_action_supplied_i">the action supplied is not valid</msg>
@@ -386,6 +391,7 @@
<msg key="lt_The_recipeints_name_a">The recipeints name and mailing address will automatically be included so that they work with window envelopes</msg>
<msg key="lt_The_second_contact_sp">The second contact specified does not exist</msg>
<msg key="lt_The_second_role_speci">The second role specified does not exist</msg>
+ <msg key="lt_There_is_no_spouse">This contact does not have a spousal relationship set. You have reached this page in error.</msg>
<msg key="lt_There_was_a_problem_w">There was a problem with your input. this type of relationship cannot exist.</msg>
<msg key="lt_there_was_an_error_processing">There was an error processing your request</msg>
<msg key="lt_This_action_cannot_be">This action cannot be taken for unmapped groups</msg>
@@ -395,6 +401,7 @@
<msg key="lt_this_is_my_default_si">this is my default signature</msg>
<msg key="lt_this_may_take_a_bit">(this may take a bit)</msg>
<msg key="lt_This_signature_specif">This signature specified either does not exist or does not belong to you</msg>
+ <msg key="lt_This_system_no_polygamy">This system does not allow polygamy.</msg>
<msg key="lt_This_user_is_awaiting">This user is awaiting administrator approval</msg>
<msg key="lt_This_users_has_not_be">This users has not been approved</msg>
<msg key="lt_Title_is_not_shown_in_the_message">Title is not shown in the message, it is used to select the appropriate message.</msg>
Index: openacs-4/packages/contacts/lib/spouse-sync.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/lib/spouse-sync.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/contacts/lib/spouse-sync.adp 28 May 2006 01:50:21 -0000 1.1
@@ -0,0 +1,6 @@
+<master src="/packages/contacts/lib/contact-master">
+<property name="party_id">@party_id@</property>
+
+<p>#contacts.lt_Select_spouse_value_in_sync#</p>
+
+<formtemplate id="spouse_sync"></formtemplate>
Index: openacs-4/packages/contacts/lib/spouse-sync.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/lib/spouse-sync.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/contacts/lib/spouse-sync.tcl 28 May 2006 01:50:21 -0000 1.1
@@ -0,0 +1,136 @@
+ad_page_contract {
+ List and manage spouse relationship.
+
+ @author Matthew Geddert openacs@geddert.com
+ @creation-date 2006-05-22
+ @cvs-id $Id: spouse-sync.tcl,v 1.1 2006/05/28 01:50:21 matthewg Exp $
+} {
+ {party_id:integer,notnull}
+ {return_url ""}
+} -validate {
+ contact_one_exists -requires {party_id} {
+ if { ![contact::exists_p -party_id $party_id] } {
+ ad_complain "[_ contacts.lt_The_contact_specified]"
+ } else {
+ set spouse_id [contact::spouse_id_not_cached -party_id $party_id]
+ if { [llength $spouse_id] == "0" } {
+ ad_complain "[_ contacts.lt_There_is_no_spouse]"
+ }
+ }
+ }
+}
+
+
+contact::require_visiblity -party_id $party_id
+
+if { $return_url eq "" } {
+ set return_url "[contact::url -party_id $party_id]relationships"
+}
+
+set spouse_id [contact::spouse_id_not_cached -party_id $party_id]
+
+# we display the attributes that will be synced whenever a user
+#
+# the party_id is the primary spouse. Thus we copy the syncable attributes
+# from that party to the spouse (by default). Before doing that we get the
+# values to verify with the user that all is well with this.
+
+set attribute_ids [contacts::spouse_sync_attribute_ids -package_id [ad_conn package_id]]
+
+
+# we get the attributes in pretty name order.
+
+set attributes [db_list_of_lists get_attributes {}]
+set attributes [ams::util::localize_and_sort_list_of_lists -list $attributes]
+
+
+set party_revision_id [contact::live_revision -party_id $party_id]
+set spouse_revision_id [contact::live_revision -party_id $spouse_id]
+set party_name [contact::name -party_id $party_id]
+set spouse_name [contact::name -party_id $spouse_id]
+set form_elements [list]
+
+foreach attribute $attributes {
+ util_unlist $attribute pretty_name attribute_id
+
+ set party_value [ams::value -object_id $party_revision_id -attribute_id $attribute_id]
+ set party_value_id [db_string get_party_value_id {} -default {}]
+ set spouse_value [ams::value -object_id $spouse_revision_id -attribute_id $attribute_id]
+ set spouse_value_id [db_string get_spouse_value_id {} -default {}]
+
+ if { $party_value eq $spouse_value && $party_value ne "" } {
+ # the attribute value is already the same, we assume
+ # that this is retained
+ continue
+ }
+
+
+ set options [list]
+ if { $party_value ne "" } {
+ set attr${attribute_id}_value $party_value_id
+ lappend options [list "<strong>$party_name:</strong><br>$party_value<br><br>" $party_value_id]
+ }
+ if { $spouse_value ne "" } {
+ if { ![exists_and_not_null attr${attribute_id}_value] } {
+ set attr${attribute_id}_value $spouse_value_id
+ }
+ lappend options [list "<strong>$spouse_name:</strong><br>$spouse_value<br><br>" $spouse_value_id]
+ }
+ if { [llength $options] > 0 } {
+ lappend options [list "<strong>[_ contacts.Delete]</strong><br><br>" "0"]
+ lappend form_elements [list attr${attribute_id}:integer(radio) \
+ [list label $pretty_name] \
+ [list options $options] \
+ ]
+
+ }
+
+}
+
+if { [llength $form_elements] == 0 } {
+ ad_returnredirect $return_url
+ ad_script_abort
+}
+
+
+ad_form \
+ -name "spouse_sync" \
+ -method "GET" \
+ -export {return_url} \
+ -form $form_elements \
+ -on_request {
+ foreach element [template::form::get_elements spouse_sync] {
+ if { [regexp {^attr[0-9]} $element match] } {
+ set $element [set ${element}_value]
+ }
+ }
+ } -on_submit {
+
+ # we first set up a new contact revision for each contact
+ set new_party_revision_id [contact::revision::new -party_id $party_id]
+ ams::object_copy -from $party_revision_id -to $new_party_revision_id
+
+ set new_spouse_revision_id [contact::revision::new -party_id $spouse_id]
+ ams::object_copy -from $spouse_revision_id -to $new_spouse_revision_id
+
+ # now we save the values specified
+ foreach element [template::form::get_elements spouse_sync] {
+ if { [regexp {^attr([0-9]{1,})$} $element match attribute_id] } {
+ set value_id [set ${element}]
+
+ if { $value_id eq "0" } {
+ # the value should be deleted
+ set value_id ""
+ }
+ ams::attribute::value_save -object_id $new_party_revision_id -attribute_id $attribute_id -value_id $value_id
+ ams::attribute::value_save -object_id $new_spouse_revision_id -attribute_id $attribute_id -value_id $value_id
+
+ }
+ }
+
+ contact::flush -party_id $party_id
+ contact::flush -party_id $spouse_id
+ contact::search::flush_results_counts
+
+ ad_returnredirect $return_url
+ }
Index: openacs-4/packages/contacts/lib/spouse-sync.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/lib/spouse-sync.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/contacts/lib/spouse-sync.xql 28 May 2006 01:50:21 -0000 1.1
@@ -0,0 +1,32 @@
+<?xml version="1.0"?>
+<queryset>
+
+<fullquery name="get_attributes">
+ <querytext>
+ select pretty_name,
+ attribute_id
+ from acs_attributes
+ where attribute_id in ([template::util::tcl_to_sql_list $attribute_ids])
+ </querytext>
+</fullquery>
+
+<fullquery name="get_party_value_id">
+ <querytext>
+ select value_id
+ from ams_attribute_values
+ where object_id = :party_revision_id
+ and attribute_id = :attribute_id
+ </querytext>
+</fullquery>
+
+<fullquery name="get_spouse_value_id">
+ <querytext>
+ select value_id
+ from ams_attribute_values
+ where object_id = :spouse_revision_id
+ and attribute_id = :attribute_id
+ </querytext>
+</fullquery>
+
+</queryset>
+
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 -r1.42 -r1.43
--- openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl 21 May 2006 00:43:42 -0000 1.42
+++ openacs-4/packages/contacts/tcl/contacts-callback-procs.tcl 28 May 2006 01:50:21 -0000 1.43
@@ -839,6 +839,63 @@
}
}
+ad_proc -public -callback contacts::multirow::extend -impl relationships {
+ {-type}
+ {-key}
+ {-select_query}
+ {-format "html"}
+} {
+} {
+ set results [list]
+ if { $type eq "groups" && [string is integer $key] && $key ne ""} {
+ set true [_ contacts.True]
+ set false [_ contacts.False]
+ db_foreach get_group_members "
+ select parties.party_id,
+ gm.member_id
+ from parties left join ( select member_id from group_approved_member_map where group_id = :key ) gm on (parties.party_id = gm.member_id)
+ where parties.party_id in ( $select_query )
+ " {
+ if { $member_id eq "" } {
+ # they are a not member
+ lappend results $party_id $false
+ } else {
+ lappend results $party_id $true
+ }
+ }
+ }
+ return $results
+}
+
+
+ad_proc -public -callback contacts::extensions -impl groups {
+ {-multirow}
+ {-user_id}
+ {-package_id}
+ {-object_type}
+} {
+} {
+ ns_log notice "starting groups impl"
+ set groups_list [list]
+ foreach group [contact::groups_list -package_id $package_id] {
+ util_unlist $group group_id group_name member_count component_count mapped_p default_p
+ # ns_log notice "$mapped_p $group_name"
+ if { [string is true $mapped_p] } {
+ if { [permission::permission_p -object_id $group_id -party_id $user_id -privilege "read"] } {
+ lappend groups_list [list $group_id $group_name]
+ }
+ }
+ }
+ if { [llength $groups_list] > 0 } {
+ set groups_pretty [_ contacts.Groups]
+ foreach group [ams::util::localize_and_sort_list_of_lists -list $groups_list -position "1"] {
+ util_unlist $group group_id group_name
+ template::multirow append $multirow groups groups $groups_pretty $group_id $group_name
+ }
+ }
+ ns_log notice "ending groups impl..."
+}
+
ad_proc -public -callback contacts::redirect -impl contactspdfs {
{-party_id ""}
{-action ""}
@@ -865,3 +922,42 @@
}
}
+
+
+ad_proc -public -callback contact::contact_form_after_submit -impl spouse_sync {
+ -party_id:required
+ -package_id:required
+ -object_type:required
+ -form:required
+} {
+ Sync information from a spousal relationship (if such a relationship exists)
+} {
+ if { [contacts::spouse_enabled_p -package_id $package_id] } {
+ # the special spousal relationship exists
+ set spouse_id [contact::spouse_id_not_cached -party_id $party_id]
+ if { $spouse_id ne "" } {
+ # this party has a spouse, the edit form has already save
+ # all of the attributes for the party so we only need to save
+ # attributes for the spouse
+
+ set party_revision_id [contact::live_revision -party_id $party_id]
+
+ set spouse_revision_id [contact::live_revision -party_id $spouse_id]
+ set new_spouse_revision_id [contact::revision::new -party_id $spouse_id]
+ ams::object_copy -from $spouse_revision_id -to $new_spouse_revision_id
+
+ set attribute_ids [contacts::spouse_sync_attribute_ids -package_id [ad_conn package_id]]
+ foreach attribute_id $attribute_ids {
+ set value_id [db_string get_value_id { select value_id from ams_attribute_values where attribute_id = :attribute_id and object_id = :party_revision_id } -default {}]
+ ams::attribute::value_save -object_id $new_spouse_revision_id -attribute_id $attribute_id -value_id $value_id
+ }
+
+ set spouse_link [contact::link -party_id $spouse_id]
+ util_user_message -html -message [_ contacts.lt_spouse_spouse_link_was_updated]
+
+ contact::flush -party_id $spouse_id
+ contact::search::flush_results_counts
+
+ }
+ }
+}
Index: openacs-4/packages/contacts/tcl/contacts-install-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/tcl/contacts-install-procs.tcl,v
diff -u -r1.21 -r1.22
--- openacs-4/packages/contacts/tcl/contacts-install-procs.tcl 23 Feb 2006 20:40:36 -0000 1.21
+++ openacs-4/packages/contacts/tcl/contacts-install-procs.tcl 28 May 2006 01:50:21 -0000 1.22
@@ -61,6 +61,19 @@
"0" \
""
+
+ rel_types::create_role -role "spouse" -pretty_name "Spouse" -pretty_plural "Spouses"
+ rel_types::new -table_name "contact_rel_employment" -create_table_p "t" -supertype "contact_rel" -role_one "spouse" -role_two "spouse" \
+ "contact_rels_spouse" \
+ "#contacts.lt_Contact_Rel_Spouse#" \
+ "#contacts.lt_Contact_Rels_Spous#" \
+ "person" \
+ "0" \
+ "" \
+ "person" \
+ "0" \
+ ""
+
# Creation of contact_complaint_track table
content::type::new -content_type "contact_complaint" \
-pretty_name "Contact Complaint" \
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 -r1.17 -r1.18
--- openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql 3 May 2006 21:27:08 -0000 1.17
+++ openacs-4/packages/contacts/tcl/contacts-procs-postgresql.xql 28 May 2006 01:50:21 -0000 1.18
@@ -42,6 +42,24 @@
</querytext>
</fullquery>
+<fullquery name="contacts::spouse_sync_attribute_ids.get_valid_attribute_ids">
+ <querytext>
+ select attribute_id
+ from ams_attributes
+ where object_type in ( 'party', 'person' )
+ and attribute_id in ([template::util::tcl_to_sql_list $attribute_ids])
+ and widget is not null
+ </querytext>
+</fullquery>
+
+<fullquery name="contacts::spouse_rel_type_enabled_p.rel_type_enabled_p">
+ <querytext>
+ select 1
+ from acs_rel_types
+ where rel_type = 'contact_rels_spouse'
+ </querytext>
+</fullquery>
+
<fullquery name="contact::util::generate_filename.get_parties_existing_filenames">
<querytext>
select name
@@ -60,6 +78,31 @@
</querytext>
</fullquery>
+<fullquery name="contact::spouse_id_not_cached.get_spouse_id">
+ <querytext>
+ select CASE WHEN object_id_one = :party_id THEN object_id_two ELSE object_id_one END
+ from acs_rels,
+ acs_objects
+ where rel_type = 'contact_rels_spouse'
+ and ( object_id_one = :party_id or object_id_two = :party_id )
+ and rel_id = object_id
+ order by creation_date
+ </querytext>
+</fullquery>
+
+<fullquery name="contact::spouse_id_not_cached.delete_rel">
+ <querytext>
+ select acs_object__delete(rel_id)
+ from acs_rels
+ where (
+ ( object_id_one = :party_id and object_id_two = :spouse )
+ or
+ ( object_id_one = :spouse and object_id_two = :party_id )
+ )
+ and rel_type = 'contact_rels_spouse'
+ </querytext>
+</fullquery>
+
<fullquery name="contact::groups_list_not_cached.get_groups">
<querytext>
select groups.group_id,
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 -r1.86 -r1.87
--- openacs-4/packages/contacts/tcl/contacts-procs.tcl 16 May 2006 06:36:22 -0000 1.86
+++ openacs-4/packages/contacts/tcl/contacts-procs.tcl 28 May 2006 01:50:21 -0000 1.87
@@ -143,6 +143,66 @@
}
}
+ad_proc -public contacts::spouse_sync_attribute_ids {
+ {-package_id:required}
+} {
+ Get the attribute_ids to keep in sync for the contact_rels_spouse relationship
+} {
+ set attribute_ids [list]
+ foreach attribute [parameter::get -parameter "SpouseSyncedAttributes" -default "" -package_id $package_id] {
+ if { [string is integer $attribute] } {
+ lappend attribute_ids $attribute
+ } else {
+ set person_attribute_id [attribute::id -object_type person -attribute_name ${attribute}]
+ if { $person_attribute_id ne "" } {
+ lappend attribute_ids $person_attribute_id
+ } else {
+ set party_attribute_id [attribute::id -object_type party -attribute_name ${attribute}]
+ if { $party_attribute_id ne "" } {
+ lappend attribute_ids $party_attribute_id
+ }
+ }
+ }
+ }
+
+ if { [llength $attribute_ids] == "0" } {
+ return {}
+ } else {
+ # now we have a list of attribute_ids, we verify that they in are in fact valid by searching
+ # for those attributes that have widgets
+ return [db_list get_valid_attribute_ids {}]
+ }
+
+}
+
+ad_proc -public contacts::spouse_enabled_p {
+ {-package_id ""}
+} {
+ Is the special contact_rels_spouse enabled for this contacts instance. Cached.
+} {
+ if { [string is false [exists_and_not_null package_id]] } {
+ set package_id [ad_conn package_id]
+ }
+
+ if { [util_memoize [list contacts::spouse_rel_type_enabled_p -package_id $package_id]] } {
+ # parameter get is cached
+ set spouse_synced_attributes [util_memoize [list contacts::spouse_sync_attribute_ids -package_id $package_id]]
+ if { [llength $spouse_synced_attributes] > 0 } {
+ return 1
+ }
+ }
+ return 0
+
+}
+
+ad_proc -public contacts::spouse_rel_type_enabled_p {
+ {-package_id:required}
+} {
+ Does the special contact_rels_spouse exist.
+} {
+ return [db_0or1row rel_type_enabled_p {}]
+}
+
ad_proc -private contact::util::generate_filename {
{-title:required}
{-extension:required}
@@ -527,6 +587,57 @@
}
}
+ad_proc -public contact::spouse_id_not_cached {
+ {-party_id:required}
+ {-package_id ""}
+} {
+ this returns the contact's spouse_id, if and only if
+ the special spousal relationship exists. It also automatically
+ deletes multiple spouse records leaving the longest established
+ one - should the contact have more than one spousal relationship set
+} {
+ if { $package_id eq "" } {
+ set package_id [ad_conn package_id]
+ }
+ set spouse_id [db_list get_spouse_id {}]
+
+ # we do not allow for more than one spouse at a time since
+ # this system is not programmed to deal with polygamy situations
+ # we automatically delete the newer spousal relationship
+ if { [llength $spouse_id] > 1 } {
+ set active_p 0
+ foreach spouse $spouse_id {
+ if { [contact::visible_p -party_id $spouse -package_id $package_id] } {
+ # they are visible to this instance, we do not delete
+ # if they are the first contact in this instance that
+ # is visible
+ if { [string is true $active_p] } {
+ db_list delete_rel {}
+ set spouse_name [contact::name -party_id $spouse]
+ util_user_message -message [_ contacts.lt_This_system_no_polygamy]
+ util_user_message -message [_ contacts.lt_Removing_spouse_name_as_spouse]
+ } else {
+ set active_p 1
+ set spouse_id $spouse
+ }
+ }
+ }
+ } elseif { [lindex $spouse_id 0] ne "" } {
+ if { ![contact::visible_p -party_id [lindex $spouse_id 0] -package_id $package_id] } {
+ set spouse_id {}
+ }
+ }
+
+ if { $spouse_id eq $party_id } {
+ util_user_message -message [_ contacts.lt_No_marrying_yourself]
+ # this is set here for the delete query
+ set spouse $spouse_id
+ db_list delete_rel {}
+ set spouse_id {}
+ }
+ return $spouse_id
+}
+
ad_proc -private contact::person_upgrade_to_user {
{-person_id ""}
{-no_perm_check "f"}
Index: openacs-4/packages/contacts/www/index.vuh
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/index.vuh,v
diff -u -r1.15 -r1.16
--- openacs-4/packages/contacts/www/index.vuh 17 May 2006 07:41:43 -0000 1.15
+++ openacs-4/packages/contacts/www/index.vuh 28 May 2006 01:50:21 -0000 1.16
@@ -32,7 +32,7 @@
}
- set valid_pages [list "" edit files groups relationships comments message merge history changes mail-tracking create-club]
+ set valid_pages [list "" edit files groups relationships comments message merge spouse-sync history changes mail-tracking create-club]
if { [lsearch $valid_pages $action] >= 0 && [llength $file_list] == "2" } {
switch $action {
@@ -43,6 +43,7 @@
comments { set file "comments" }
message { set file "message" }
merge { set file "/packages/contacts/lib/merge" }
+ spouse-sync { set file "/packages/contacts/lib/spouse-sync" }
letter { set file "letter" }
email { set file "email" }
complaint { set file "complaint" }
@@ -52,7 +53,6 @@
create-club { set file "create-club" }
default { set file [parameter::get -parameter "ContactSummaryViewTemplate" -default "/packages/contacts/www/contact"] }
}
-
set form_supplied_party_id [ns_queryget party_id]
if { [exists_and_not_null form_supplied_party_id] } {
if { $form_supplied_party_id != $party_id } {
Index: openacs-4/packages/contacts/www/relationship-ae.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/contacts/www/relationship-ae.tcl,v
diff -u -r1.14 -r1.15
--- openacs-4/packages/contacts/www/relationship-ae.tcl 4 May 2006 11:37:20 -0000 1.14
+++ openacs-4/packages/contacts/www/relationship-ae.tcl 28 May 2006 01:50:21 -0000 1.15
@@ -28,6 +28,8 @@
}
}
+
+
contact::require_visiblity -party_id $object_id_one
contact::require_visiblity -party_id $object_id_two
@@ -46,13 +48,13 @@
{object_id_two:integer(hidden)}
{party_id:integer(hidden)}
{rel_type:text(hidden)}
- {return_url:text(hidden),optional}
}
append form_elements [ams::ad_form::elements -package_key "contacts" -object_type $rel_type -list_name [ad_conn package_id]]
ad_form -name rel_form \
-mode "edit" \
-form $form_elements \
+ -export {return_url} \
-on_request {
} -new_request {
} -edit_request {
@@ -99,12 +101,18 @@
set return_url "[contact::url -party_id $party_id -package_id $package_id]relationships"
}
set redirect_rel_types [parameter::get -parameter EditDataAfterRel -package_id [ad_conn package_id] -default ""]
+
if { [regexp {\*} $redirect_rel_types match] || [lsearch $redirect_rel_types $rel_type] >= 0 } {
# we need to redirect the party to the attribute add/edit page
set return_url [export_vars -base "[contact::url -party_id $party_id -package_id $package_id]edit" -url {return_url}]
append message ". [_ contacts.lt_update_contact_if_needed]"
}
+ # they have the special contact spouse rel enabled
+ if { $rel_type eq "contact_rels_spouse" && [contacts::spouse_enabled_p -package_id $package_id] } {
+ set return_url [export_vars -base "[contact::url -party_id $party_id]spouse-sync"]
+ }
+
util_user_message -message $message
ad_returnredirect $return_url
ad_script_abort