Index: openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl,v
diff -u -N -r1.74 -r1.74.8.1
--- openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl	13 Nov 2003 09:13:16 -0000	1.74
+++ openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl	16 Jun 2005 22:32:19 -0000	1.74.8.1
@@ -411,3 +411,67 @@
     }
 
 }
+
+namespace eval dotlrn::merge {
+
+    ad_proc -callback MergeShowUserInfo -impl dotlrn {
+	-user_id:required
+    } {
+	Show dotlrn items 	
+    } {
+	set msg "dotLRN items for $user_id"
+	ns_log Notice $msg
+	set result [list $msg]
+	
+	set from_rel_ids [db_list_of_lists get_from_rel_ids { *SQL* } ]	    
+	
+	foreach rel $from_rel_ids {
+	    set l_rel_id [lindex $rel 0]
+	    set l_rel_type [lindex $rel 1]
+	    set l_community_id [lindex $rel 2]
+	    
+	    lappend result [list "This user has the rel_type : $l_rel_type in community_id : $l_community_id" ] 
+	}
+	
+	return $result
+    }
+    
+    ad_proc -callback MergePackageUser -impl dotlrn {
+	-from_user_id:required
+	-to_user_id:required
+    } {
+	Merge the dotlrn items of two users.
+	The from_user_id is the user_id of the user
+	that will be deleted and all the dotlrn elements
+	of this user will be mapped to to_user_id.
+	
+    } {
+	ns_log Notice "Merging dotlrn"
+
+	db_transaction {
+  
+	    # select the communities where from_user_id belongs to and
+	    # to_user_id does not belong.
+	    set from_rel_ids [db_list_of_lists get_from_rel_ids { *SQL* } ]	    
+	    
+	    foreach rel $from_rel_ids {
+		set l_rel_id [lindex $rel 0]
+		set l_rel_type [lindex $rel 1]
+		set l_community_id [lindex $rel 2]
+		
+		# Add to_user_id to the communities
+		# where from_user_id is with the same role
+		# Add the relation
+		dotlrn_community::add_user -rel_type $l_rel_type $l_community_id $to_user_id
+
+	    }
+
+	    # remove the user
+	    dotlrn::user_remove -user_id $from_user_id
+	    
+	    set result ".LRN merge is done"
+	} 
+	
+	return $result
+    }
+}
\ No newline at end of file
Index: openacs-4/packages/dotlrn/tcl/dotlrn-procs.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-procs.xql,v
diff -u -N -r1.17 -r1.17.8.1
--- openacs-4/packages/dotlrn/tcl/dotlrn-procs.xql	3 Oct 2003 17:37:58 -0000	1.17
+++ openacs-4/packages/dotlrn/tcl/dotlrn-procs.xql	16 Jun 2005 22:32:20 -0000	1.17.8.1
@@ -65,4 +65,23 @@
         </querytext>
     </fullquery>
 
+    <fullquery name="callback::MergePackageUser::impl::dotlrn.get_from_rel_ids">
+        <querytext>	
+        select rel_id, rel_type, object_id_one
+	from acs_rels 
+	where object_id_two = :from_user_id
+	and object_id_one not in (select object_id_one 
+	                          from acs_rels 
+	                          where object_id_two = :to_user_id )
+        </querytext>
+    </fullquery>
+
+    <fullquery name="callback::MergeShowUserInfo::impl::dotlrn.get_from_rel_ids">
+        <querytext>	
+        select rel_id, rel_type, object_id_one
+	from acs_rels 
+	where object_id_two = :user_id
+        </querytext>
+    </fullquery>
+
 </queryset>