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.89 -r1.90
--- openacs-4/packages/contacts/tcl/contacts-procs.tcl	2 Jun 2006 09:18:31 -0000	1.89
+++ openacs-4/packages/contacts/tcl/contacts-procs.tcl	7 Jun 2006 00:14:18 -0000	1.90
@@ -973,3 +973,215 @@
     }
 }
 
+
+
+
+ad_proc -public contacts::merge {
+    {-from_party_id:required}
+    {-to_party_id:required}
+} {
+    Merge two contacts, there is also a contacts::merge callback so that other packages can
+    get in on the action of this proc.
+} {
+    
+    foreach name [ns_cache names util_memoize] {
+	ns_cache flush util_memoize $name
+    } 
+
+
+    db_transaction {
+	# contact messages
+	db_dml update_message_log { update contact_message_log set recipient_id = :to_party_id where recipient_id = :from_party_id }
+	
+
+	# AMS Attributes
+	
+	set revision_id [contact::live_revision -party_id $to_party_id]
+	set new_revision_id [contact::revision::new -party_id $to_party_id]
+	ams::object_copy -from $revision_id -to $new_revision_id
+	
+	set merge_revision_id [contact::live_revision -party_id $from_party_id]
+	ams::object_copy -from $merge_revision_id -to $new_revision_id
+	
+
+	# Generic Attributes
+	
+	db_dml delete_empty_attribute_values "
+	    delete from acs_attribute_values where object_id = :to_party_id and attr_value is null
+	"
+	
+
+	db_dml update_generic_attributes "
+
+	    insert into acs_attribute_values
+	    (object_id,attribute_id,attr_value)
+	    ( select :to_party_id,
+	             attribute_id,
+                     attr_value
+                from acs_attribute_values
+               where object_id = :from_party_id 
+                 and attribute_id not in ( select attribute_id from acs_attribute_values where object_id = :to_party_id and attr_value is not null )
+            )
+
+	"
+
+	# we only update email addresses and url if it doesn't exists on the primary party_id
+	if { ![db_0or1row get_it " select 1 from parties where party_id = :to_party_id and email is not null "] } {
+	    set email [db_string get_info " select email from parties where party_id = :from_party_id " -default {}]
+	    if { [exists_and_not_null email] } {
+		db_dml update_it " update parties set email = NULL where party_id = :from_party_id "
+		db_dml update_it " update parties set email = :email where party_id = :to_party_id "
+		if { [contact::type -party_id $to_party_id] == "user" } {
+		    # db_dml update_it " update users set username = :from_party_id where user_id = :from_party_id "
+		    # db_dml update_it " update users set username = :email where user_id = :to_party_id "
+		}
+	    }
+	}
+	if { ![db_0or1row get_it " select 1 from parties where party_id = :to_party_id and url is not null "] } {
+	    set url [db_string get_info " select url from parties where party_id = :from_party_id " -default {}]
+	    if { [exists_and_not_null url] } {
+		db_dml update_it " update parties set url = NULL where party_id = :from_party_id "
+		db_dml update_it " update parties set url = :url where party_id = :to_party_id "
+	    }
+	}
+
+
+	# files
+	db_dml update_it { update acs_objects set context_id = :to_party_id where object_id in ( select item_id from cr_items where parent_id = :from_party_id ) }
+	db_dml update_it { update cr_items set parent_id = :to_party_id where parent_id = :from_party_id }
+	
+
+	# cr_child _rels
+	db_dml update_it { update acs_objects set context_id = :to_party_id where object_id in ( select rel_id from cr_child_rels where parent_id = :from_party_id ) }
+	db_dml update_it { update cr_child_rels set parent_id = :to_party_id where parent_id = :from_party_id }
+
+
+
+	# Tasks
+	if { [apm_package_installed_p tasks] } {
+	    db_dml update_it { update pm_task_assignment set party_id = :to_party_id where party_id = :from_party_id }
+	}
+
+	# General Comments
+	db_dml update_contexts { update acs_objects set context_id = :to_party_id where object_id in ( select comment_id from general_comments where object_id = :from_party_id ) }
+	db_dml update_comments { update general_comments set object_id = :to_party_id where object_id = :from_party_id }
+
+	# Forums Messages
+	# if contacts becomes ubiquitous enough this should be moved to a callback managed by the forums packages
+	if { [apm_package_installed_p forums] } {
+	    db_dml update_contexts { update acs_objects set creation_user = :to_party_id where object_id in ( select message_id from forums_messages where user_id = :from_party_id ) }
+	    db_dml update_messages { update forums_messages set user_id = :to_party_id where user_id = :from_party_id }
+	}
+
+	# Mail Lite
+	if { [apm_package_installed_p acs-mail-lite] } {
+	    
+	    db_dml update_acs_mail_lite_mail_log { update acs_mail_lite_mail_log set party_id = :to_party_id where party_id = :from_party_id }
+	    
+	}
+	
+	# Mail Tracking
+	if { [apm_package_installed_p mail-tracking] } {
+	    
+	    db_dml update_acs_mail_log_sender    { update acs_mail_log set sender_id = :to_party_id where sender_id = :from_party_id }
+	    db_dml update_acs_mail_log_recipient { update acs_mail_log set recipient_id = :to_party_id where recipient_id = :from_party_id }
+	    
+	}
+
+	# Notifications
+	# if contacts becomes ubiquitous enough this should be moved to a callback managed by the notifications package
+	if { [apm_package_installed_p notifications] } {
+	    
+	    if { [contact::type -party_id $to_party_id] == "user" } {
+		set update_user_info 1
+	    } else {
+		set update_user_info 0
+	    }
+
+	    set notifications [db_list_of_lists get_them { select type_id, request_id from notification_requests where user_id = :from_party_id }]
+	    foreach notification $notifications {
+		util_unlist $notification type_id request_id
+		set existing_request_id [db_string get_it " select request_id from notification_requests where type_id = :type_id and user_id = :to_party_id and object_id = :request_id " -default {}]
+		if { ![exists_and_not_null existing_request_id] } {
+		    db_dml update_it " update notification_requests set user_id = :to_party_id where request_id = :request_id "
+		    if { [string is true $update_user_info] } {
+			db_dml update_it " update acs_objects set creation_user = :to_party_id where object_id = :request_id "
+		    }
+		}
+	    }
+	    
+	}
+
+
+	callback contacts::merge -from_party_id $from_party_id -to_party_id $to_party_id
+
+
+        set rels [db_list_of_lists get_them " select rel_id, rel_type, object_id_one, object_id_two  from acs_rels where ( object_id_one = :from_party_id or object_id_two = :from_party_id )"]
+	foreach rel $rels {
+	    util_unlist $rel rel_id rel_type object_id_one object_id_two
+	    if { $object_id_one == $from_party_id } {
+		set object_id_one $to_party_id
+	    } else {
+		set object_id_two $to_party_id
+	    }
+	    set existing_rel_id [db_string existing_p " select rel_id from acs_rels where rel_type = :rel_type and object_id_one = :object_id_one and object_id_two = :object_id_two " -default {}]
+	    if { ![exists_and_not_null existing_rel_id] } {
+		db_dml update_it " update acs_rels set object_id_one = :object_id_one, object_id_two = :object_id_two where rel_id = :rel_id "
+	    } else {
+		ams::object_copy -from $rel_id -to $existing_rel_id
+                # delete rel
+		db_1row delete_it { select acs_rel__delete(:rel_id) }
+	    }
+	}
+
+	# Application data links
+	set party_links [application_data_link::get -object_id $to_party_id]
+	foreach linked_object_id [application_data_link::get -object_id $from_party_id] {
+	    if { [lsearch $party_links $linked_object_id] < 0 } {
+		application_data_link::new -this_object_id $to_party_id -target_object_id $linked_object_id
+	    }
+	}
+	application_data_link::delete_links -object_id $from_party_id
+
+
+	# first we delete the contact_party_revisions
+	db_dml update_it { update cr_items set live_revision = NULL, latest_revision = NULL where item_id = :from_party_id }
+	db_list do_it { select content_revision__delete(revision_id) from cr_revisions where item_id = :from_party_id }
+	db_dml delete_item { delete from cr_items where item_id = :from_party_id }
+
+	# now we delete group membership
+	db_list do_it { select acs_rel__delete(rel_id) from acs_rels where object_id_one = :from_party_id or object_id_two = :from_party_id }
+
+	# now we update creation_user logs
+	db_dml update_it { update acs_objects set creation_user = :to_party_id where creation_user = :from_party_id }
+	db_dml update_it { update acs_objects set modifying_user = :to_party_id where modifying_user = :from_party_id }
+
+	db_dml update_it { update group_element_index set element_id = :to_party_id where element_id = :from_party_id }
+	db_dml update_it { delete from party_approved_member_map where party_id = :from_party_id and member_id = :from_party_id }
+	db_dml update_it { update party_approved_member_map set member_id = :to_party_id where member_id = :from_party_id }
+	db_dml update_it { update party_approved_member_map set party_id = :to_party_id where party_id = :from_party_id }
+
+
+	if { [contact::type -party_id $from_party_id] == "user" } {
+	    # nuke the user from the database
+	    acs_user::delete -user_id $from_party_id -permanent
+	} else {
+	    db_dml delete_org_type { delete from organization_type_map where organization_id = :from_party_id }
+	    db_exec_plsql permanent_delete { select acs_object__delete(:from_party_id)  }
+	}
+	
+    } on_error {
+	# something went wrong. this site might need a custom contacts::merge callback
+	ad_return_error "Error." $errmsg
+	ad_script_abort
+    }
+    
+    foreach name [ns_cache names util_memoize] {
+	ns_cache flush util_memoize $name
+    } 
+    contact::flush -party_id $to_party_id
+    contact::flush -party_id $from_party_id
+
+}
+
+