Index: openacs-4/packages/dotlrn/tcl/dotlrn-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-callback-procs.tcl,v diff -u -r1.8.2.1 -r1.8.2.2 --- openacs-4/packages/dotlrn/tcl/dotlrn-callback-procs.tcl 18 Oct 2021 11:56:46 -0000 1.8.2.1 +++ openacs-4/packages/dotlrn/tcl/dotlrn-callback-procs.tcl 18 Oct 2021 11:59:56 -0000 1.8.2.2 @@ -1,7 +1,7 @@ ad_library { - + Callback Procedures offered by the .LRN package - + @author Malte Sussdorff (sussdorff@sussdorff.de) @creation-date 2005-07-19 @cvs-id $Id$ @@ -17,7 +17,7 @@ Actions to be performed by other packages when a community changes name. Note that dotlrn-specific packages (as applets) already - implement a way to react to actions. + implement a way to react to actions. } - @@ -46,26 +46,27 @@ } - #### Callbacks + ad_proc -callback merge::MergeShowUserInfo -impl dotlrn { -user_id:required } { - Show dotlrn items + Show dotlrn items } { ns_log notice "Starting MergeShowUserInfo for dotLRN" 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 {} ] - + + set from_rel_ids [db_list_of_lists get_from_rel_ids {} ] + 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" ] + 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 } @@ -78,58 +79,53 @@ 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" + set from_fs_root_folder [dotlrn_fs::get_user_root_folder -user_id $from_user_id ] + set to_fs_root_folder [dotlrn_fs::get_user_root_folder -user_id $to_user_id ] - set from_fs_root_folder [dotlrn_fs::get_user_root_folder -user_id $from_user_id ] - set to_fs_root_folder [dotlrn_fs::get_user_root_folder -user_id $to_user_id ] + set from_fs_shared_folder [dotlrn_fs::get_user_shared_folder -user_id $from_user_id ] + set to_fs_shared_folder [dotlrn_fs::get_user_shared_folder -user_id $to_user_id ] - set from_fs_shared_folder [dotlrn_fs::get_user_shared_folder -user_id $from_user_id ] - set to_fs_shared_folder [dotlrn_fs::get_user_shared_folder -user_id $to_user_id ] - - - db_transaction { - # select the communities where from_user_id belongs to and - # to_user_id does not belong. + # 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 {} ] + set from_rel_ids [db_list_of_lists get_from_rel_ids {} ] - 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 - } + 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] - # remove the user - dotlrn::user_remove -user_id $from_user_id + # 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 + #change the name on duplicate files, this is to preserve the unique names constraint + db_foreach merge_dotlrn_fs_get_duplicates " " { -#change the name on duplicate files, this is to preserve the unique names constraint - db_foreach merge_dotlrn_fs_get_duplicates " " { + set newname $from_user_id$name + db_dml change_names "update cr_items set name = :newname where item_id = :item_id" - set newname $from_user_id$name - db_dml change_names "update cr_items set name = :newname where item_id = :item_id" - - } - ns_log notice "duplicate names changed" + } + ns_log notice "duplicate names changed" db_dml merge_dotlrn_fs_shared_folder " " - ns_log notice "shared folder merges, done" + ns_log notice "shared folder merges, done" db_dml merge_dotlrn_fs " " - ns_log notice "root folder merges, done" - ns_log notice ".LRN merge is done" - set result ".LRN merge is done" - } - + ns_log notice "root folder merges, done" + ns_log notice ".LRN merge is done" + set result ".LRN merge is done" + } + return $result } @@ -150,15 +146,15 @@ @return should return a 3 element list of from_addr subject email_body. If no email exists, should return -code continue to return no results to the caller - + } - ad_proc -callback dotlrn::member_email_var_list { -community_id -type {-to_user ""} } { - + @return list of varname value pairs to pass to an email template } - @@ -193,22 +189,17 @@ Callback to add an organization's employee to dotLRN. It also registers all employees of the organization within the club } { - - + + db_1row get_community_id {} - - + + dotlrn_privacy::set_user_guest_p -user_id $party_id -value "t" dotlrn::user_add -can_browse -user_id $party_id dotlrn_community::add_user_to_community -community_id $community_id -user_id $party_id - - - - + } - - # Local variables: # mode: tcl # tcl-indent-level: 4