Index: openacs-4/packages/dotlrn/tcl/community-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/community-procs.tcl,v diff -u -r1.169 -r1.169.2.1 --- openacs-4/packages/dotlrn/tcl/community-procs.tcl 10 Oct 2002 06:07:25 -0000 1.169 +++ openacs-4/packages/dotlrn/tcl/community-procs.tcl 17 Oct 2002 12:23:12 -0000 1.169.2.1 @@ -217,7 +217,7 @@ where object_id = :community_id } - set template_id [dotlrn::get_portal_id_from_type -type $community_type] + set template_id [dotlrn::get_portal_id_from_type -type $object_type] # Create comm's portal page set portal_id [portal::create \ @@ -311,8 +311,21 @@ # this community should be able to read this instance (and # it's children) permission::set_not_inherit -object_id $community_id - - return $community_id + + #this block sets permissions for subcommunities + while {1} { + if {![empty_string_p $parent_community_id]} { + #admin of the parent need admin on the subcommunity. + set parent_admin_party [db_string "parent_admin_party" "select segment_id from rel_segments where group_id = :parent_community_id and rel_type='dotlrn_admin_rel'"] + permission::grant -party_id $parent_admin_party -object_id $community_id -privilege "admin" + + #if this community has a parent we need to work up the chain. + set parent_community_id [get_parent_id -community_id $parent_community_id] + + } else { + return $community_id + } + } } ad_proc set_active_dates { @@ -376,12 +389,10 @@ ad_proc -private get_default_roles_not_cached { {-community_type:required} } { - set toplevel_community_type [get_toplevel_community_type -community_type $community_type] - - if {[string match $toplevel_community_type dotlrn_class_instance]} { - set community_type dotlrn_class_instance - } else { + if {[string match $community_type dotlrn_club]} { set community_type dotlrn_community + } elseif {![string match $community_type dotlrn_community]} { + set community_type dotlrn_class_instance } return [db_list_of_lists select_role_data {}] @@ -571,6 +582,9 @@ set member_segment_id [get_members_rel_id -community_id $community_id] set admin_segment_id [get_admin_rel_id -community_id $community_id] + set parent_id [dotlrn_community::get_parent_id -community_id $community_id] + set parent_admin_segment_id [get_admin_rel_id -community_id $parent_id] + permission::grant \ -party_id $member_segment_id \ -object_id $community_id \ @@ -744,6 +758,7 @@ } util_memoize_flush "dotlrn_community::list_users_not_cached -rel_type $rel_type -community_id $community_id" + util_memoize_flush_regexp $user_id } ad_proc -public add_user_to_community { @@ -771,6 +786,12 @@ ns_set put $extra_vars user_id $user_id ns_set put $extra_vars community_id $community_id + ns_log notice "rel_type is sending the following to relation_add -member_state needs approval \ + -extra_vars $extra_vars \ + $rel_type \ + $community_id \ + $user_id " + # Set up the relationship if {[catch {set rel_id [relation_add \ -member_state "needs approval" \ @@ -860,8 +881,10 @@ # flush the list_users cache util_memoize_flush "dotlrn_community::list_users_not_cached -rel_type $rel_type -community_id $community_id" } + util_memoize_flush_regexp $user_id } + ad_proc -public get_all_communities_by_user { user_id } { @@ -1118,6 +1141,7 @@ {-community_id:required} {-pretext "
  • "} {-join_target register} + {-drop_target deregister} {-only_member_p 0} } { Returns a html fragment of the subcommunity hierarchy of this @@ -1140,22 +1164,23 @@ if {[empty_string_p $user_id]} { set user_id [ad_get_user_id] } - foreach sc_id [get_subcomm_list -community_id $community_id] { - if {[has_subcommunity_p -community_id $sc_id] \ && [member_p $sc_id $user_id]} { # Shows the subcomms of this subcomm ONLY IF I'm a # member of the current comm set url [get_community_url $sc_id] append chunk "$pretext [get_community_name $sc_id]\n" - if {[dotlrn::user_can_admin_community_p -community_id $sc_id]} { - append chunk "\[ admin \]" - } + append chunk "\"Drop\"\n" + +# Removing admin to improve performance +# if {[dotlrn::user_can_admin_community_p -community_id $sc_id]} { +# append chunk " \"Administer\"\n" +# } append chunk "\n" - } elseif {[member_p $sc_id $user_id] || [dotlrn::user_can_admin_community_p -community_id $sc_id] || [not_closed_p -community_id $sc_id]} { + } elseif {[member_p $sc_id $user_id] || [not_closed_p -community_id $sc_id]} { # Shows the subcomm if: # 1. I'm a member of this subcomm OR @@ -1180,24 +1205,27 @@ append chunk "$pretext [get_community_name $sc_id]\n" if {![member_p $sc_id $user_id] && [not_closed_p -community_id $sc_id]} { + append chunk "" - append chunk "\[ " - if {[member_pending_p -community_id $sc_id -user_id $user_id]} { append chunk "Pending Approval" } elseif {[needs_approval_p -community_id $sc_id]} { - append chunk ">Request Membership\n" - + append chunk "\"Request\n" } else { - append chunk "Join\n" + append chunk "\"Join\"\n" } - append chunk " \]\n" - } + append chunk "\n" + } elseif {[member_p $sc_id $user_id]} { - if {[dotlrn::user_can_admin_community_p -community_id $sc_id]} { - append chunk "\[ Administer \]\n" - } + # User is a member. + append chunk "\"Drop\"\n" + + } + #Removing admin to improve performance. +# if {[dotlrn::user_can_admin_community_p -community_id $sc_id]} { +# append chunk " \"Administer\"\n" +# } } } @@ -1294,7 +1322,8 @@ } { if {[subcommunity_p -community_id $community_id]} { set parent_name [get_parent_name -community_id $community_id] - return [concat "$parent_name : [get_community_name $community_id]"] + set parent_url [get_community_url [get_parent_id -community_id $community_id]] + return [concat "$parent_name : [get_community_name $community_id]"] } else { return [get_community_name $community_id] } Index: openacs-4/packages/dotlrn/tcl/community-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/community-procs.xql,v diff -u -r1.78 -r1.78.2.1 --- openacs-4/packages/dotlrn/tcl/community-procs.xql 31 Jul 2002 21:18:32 -0000 1.78 +++ openacs-4/packages/dotlrn/tcl/community-procs.xql 17 Oct 2002 12:23:12 -0000 1.78.2.1 @@ -26,12 +26,6 @@ - - - select package_id from dotlrn_community_types where community_type= :community_type - - - update dotlrn_communities_all set package_id= :package_id where community_id= :community_id @@ -166,7 +160,7 @@ and registered_users.user_id not in (select dm.user_id from dotlrn_member_rels_full dm where dm.community_id = :subcomm_id) - order by dotlrn_member_rels_approved.rel_type, registered_users.last_name + order by last_name @@ -372,15 +366,15 @@ select 1 - from dotlrn_active_comms_not_closed + from dotlrn_communities_not_closed where community_id = :community_id select 1 - from dotlrn_active_comms_not_closed + from dotlrn_communities_not_closed where community_id = :community_id and join_policy = 'open' @@ -389,7 +383,7 @@ select 1 - from dotlrn_active_comms_not_closed + from dotlrn_communities_not_closed where community_id = :community_id and join_policy = 'needs approval' @@ -468,6 +462,18 @@ + + + select impl_name + from acs_sc_impls, + acs_sc_bindings, + acs_sc_contracts + where acs_sc_impls.impl_id = acs_sc_bindings.impl_id + and acs_sc_contracts.contract_id = acs_sc_bindings.contract_id + and acs_sc_contracts.contract_name = 'dotlrn_applet' + + + select dotlrn_applets.applet_key @@ -478,6 +484,14 @@ + + + select applet_key + from dotlrn_applets + where active_p = 't' + + + select dotlrn_applets.applet_key Index: openacs-4/packages/dotlrn/tcl/dotlrn-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-init.tcl,v diff -u -r1.33 -r1.33.2.1 --- openacs-4/packages/dotlrn/tcl/dotlrn-init.tcl 9 Aug 2002 18:39:25 -0000 1.33 +++ openacs-4/packages/dotlrn/tcl/dotlrn-init.tcl 17 Oct 2002 12:23:12 -0000 1.33.2.1 @@ -76,14 +76,16 @@ # init of each applet NOTE: this applet_add proc _must_ be able to be # called repeatedly since this script is eval'd at every server startup foreach applet [db_list select_not_installed_applets {}] { - dotlrn_applet::applet_call $applet AddApplet [list] + if {[catch {dotlrn_applet::applet_call $applet AddApplet [list]} errMsg]} { + ns_log warning "dotlrn-init: AddApplet $applet failed\n$errMsg" + } } ns_log notice "dotlrn-init: dotlrn is instantiated, about to call dotlrn::init" if {![dotlrn::is_initialized]} { dotlrn::init } - ns_log notice "dotlrn-init: about to call dotlrn_class:init" + ns_log notice "dotlrn-init: about to call dotlrn_class::init" if {![dotlrn_class::is_initialized]} { dotlrn_class::init } Index: openacs-4/packages/dotlrn/tcl/dotlrn-main-portlet-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-main-portlet-procs.tcl,v diff -u -r1.25 -r1.25.2.1 --- openacs-4/packages/dotlrn/tcl/dotlrn-main-portlet-procs.tcl 9 Aug 2002 18:39:25 -0000 1.25 +++ openacs-4/packages/dotlrn/tcl/dotlrn-main-portlet-procs.tcl 17 Oct 2002 12:23:12 -0000 1.25.2.1 @@ -35,7 +35,7 @@ ad_proc -public get_pretty_name { } { - return [parameter::get -parameter dotlrn_main_portlet_pretty_name] + return [parameter::get -package_id [dotlrn::get_package_id] -parameter dotlrn_main_portlet_pretty_name] } ad_proc -public link { 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 -r1.67 -r1.67.2.1 --- openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl 14 Aug 2002 19:24:47 -0000 1.67 +++ openacs-4/packages/dotlrn/tcl/dotlrn-procs.tcl 17 Oct 2002 12:23:12 -0000 1.67.2.1 @@ -411,7 +411,9 @@ foreach applet_key $default_applets_list { if {[dotlrn_applet::applet_exists_p -applet_key $applet_key]} { - dotlrn_community::applet_call $applet_key AddPortlet [list $portal_id] + if {[catch {dotlrn_community::applet_call $applet_key AddPortlet [list $portal_id]} errMsg]} { + ns_log warning "FAILED: dotlrn_community::applet_call $applet_key AddPortlet [list $portal_id]\n$errMsg" + } } } } Index: openacs-4/packages/dotlrn/tcl/dotlrn-security-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/dotlrn-security-procs.tcl,v diff -u -r1.49 -r1.49.2.1 --- openacs-4/packages/dotlrn/tcl/dotlrn-security-procs.tcl 9 Aug 2002 18:39:25 -0000 1.49 +++ openacs-4/packages/dotlrn/tcl/dotlrn-security-procs.tcl 17 Oct 2002 12:23:12 -0000 1.49.2.1 @@ -1,5 +1,5 @@ # -# Copyright (C) 2001, 2002 MIT +# Copyright (C) 2001, 2002 OpenForce, Inc. # # This file is part of dotLRN. # @@ -51,7 +51,13 @@ set name "$name-1" } } - + + #bad things happen if the group name is the same as a dotlrn file name. + set conflicting_names [list members configure spam index not-allowed clone help] + if { [lsearch -exact $conflicting_names $name] != -1 } { + lappend name "-1" + } + return $name } @@ -119,7 +125,7 @@ set portal_id [portal::create \ -template_id $template_id \ -name "Your dotLRN Workspace" \ - $user_id \ + $user_id ] ns_set put $extra_vars portal_id $portal_id @@ -143,12 +149,17 @@ # are selecting from changes inside the loop causing all kinds of # dead lock issues. set current_memberships [db_list_of_ns_sets select_current_memberships { - select community_id, + select dotlrn_member_rels_full.community_id, rel_type, member_state - from dotlrn_member_rels_full + from dotlrn_member_rels_full, dotlrn_communities where user_id = :user_id + and dotlrn_member_rels_full.community_id = dotlrn_communities.community_id + and dotlrn_communities.parent_community_id is null }] + + # Note that remove_user will remove users from the subgroups as well as the + # parent community. Therefore, current_memberships only contains parent communities. foreach row $current_memberships { dotlrn_community::remove_user [ns_set get $row community_id] $user_id @@ -257,10 +268,15 @@ } { Check if a user can read sensitive data in dotLRN } { - return [acs_privacy::user_can_read_private_data_p \ - -user_id $user_id \ - -object_id [dotlrn::get_package_id] \ - ] + if { [parameter::get -parameter protect_private_data_p -default 1] } { + return [ad_permission_p \ + -user_id $user_id \ + [dotlrn::get_package_id] \ + read_private_data + ] + } else { + return 1 + } } ad_proc -public require_user_read_private_data { @@ -363,6 +379,26 @@ } } + ad_proc -public user_can_spam_community_p { + {-user_id ""} + {-community_id:required} + } { + check if a user can admin a community + } { + return [permission::permission_p -party_id $user_id -object_id $community_id -privilege dotlrn_spam_community] + } + + ad_proc -public require_user_spam_community { + {-user_id ""} + {-community_id:required} + } { + require that user be able to spam a community + } { + if {![user_can_spam_community_p -user_id $user_id -community_id $community_id]} { + do_abort + } + } + ad_proc -public admin_p { {-user_id ""} } { Index: openacs-4/packages/dotlrn/tcl/navigation-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/dotlrn/tcl/navigation-procs.tcl,v diff -u -r1.17 -r1.17.2.1 --- openacs-4/packages/dotlrn/tcl/navigation-procs.tcl 10 Oct 2002 07:57:27 -0000 1.17 +++ openacs-4/packages/dotlrn/tcl/navigation-procs.tcl 17 Oct 2002 12:23:12 -0000 1.17.2.1 @@ -106,6 +106,9 @@ {-user_id:required} {-link_control_panel:required} {-control_panel_text:required} + {-link_all 0} + {-pre_html ""} + {-post_html ""} } { A helper procedure that generates the PORTAL navbar (the thing with the portal pages on it) for dotlrn. It is called from the @@ -115,8 +118,8 @@ set dotlrn_url [dotlrn::get_url] set community_id [dotlrn_community::get_community_id] set control_panel_name control-panel - set link_all 0 - + set control_panel_url "$dotlrn_url/$control_panel_name" + if {[empty_string_p $community_id]} { # We are not under a dotlrn community. However we could be # under /dotlrn (i.e. in the user's portal) or anywhere @@ -143,8 +146,9 @@ set text [dotlrn_community::get_community_header_name $community_id] set control_panel_name one-community-admin set link [dotlrn_community::get_community_url $community_id] - - # figure out what privs this user has on the community + set control_panel_url "$link/$control_panel_name" + + # figure out what this privs this user has on the community set admin_p [dotlrn::user_can_admin_community_p \ -user_id $user_id \ -community_id $community_id @@ -177,13 +181,15 @@ # # Common code for the the behavior of the control panel link # + set extra_td_selected_p 0 if {$show_control_panel} { if {$link_control_panel} { set extra_td_html \ - "   $control_panel_text" + "$control_panel_text" } else { - set extra_td_html "   $control_panel_text" + set extra_td_html "$control_panel_text" set link_all 1 + set extra_td_selected_p 1 } } else { set extra_td_html {} @@ -195,10 +201,11 @@ -portal_id $portal_id \ -link $link \ -link_all $link_all \ - -pre_html "" \ - -post_html "" \ + -pre_html $pre_html \ + -post_html $post_html \ -extra_td_html $extra_td_html \ - -table_html_args "class=\"navbar\""] + -extra_td_selected_p $extra_td_selected_p \ + -table_html_args "class=\"navbar\" border=0 cellspacing=0 cellpadding=3"] } }