/etc/dotlrn/install/tcl/class-procs.tcl is in dotlrn 2.5.0+dfsg2-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 | # Procs to support testing OpenACS with Tclwebtest.
#
# .LRN Class procs.
#
# @author Peter Marklund
namespace eval ::twt::class {}
namespace eval ::twt::class::test {}
ad_proc ::twt::class::get_admin_urls { } {
Returns a list with the fully qualified URLs of the admin pages of
all .LRN classes.
} {
set term_id [::twt::dotlrn::current_term_id]
set page_url [::twt::dotlrn::class_admin_url -term_id $term_id]
set url_pattern {/dotlrn/classes/.*/one-community-admin$}
return [::twt::get_url_list $page_url $url_pattern]
}
ad_proc ::twt::class::get_urls { } {
Returns a list with the fully qualified URLs of the home pages of
all .LRN classes.
} {
# The trick we use here is that we know that class urls are the admin
# URLs minus "one-community-admin"
set url_list [list]
set admin_url_list [get_admin_urls]
foreach admin_url $admin_url_list {
regexp {^(.*)one-community-admin$} $admin_url match class_url
lappend url_list $class_url
}
return $url_list
}
ad_proc ::twt::class::engineering_p { class_url } {
return [regexp {dotlrn/classes/(computer-science|mathematics)} $class_url match]
}
ad_proc ::twt::class::follow_members_link {} {
link follow ~u {members$}
}
ad_proc ::twt::class::get_professor { class_url } {
# TODO: find the professor of the class
class::follow_members_link
# This is fragile...
# TODO regexping on HTML code is too fragile
# write special pages that export such data instead
return [user::get_random_users professor 1]
}
ad_proc ::twt::class::setup_memberships { server_url } {
foreach admin_url [get_admin_urls] {
# Admin page for the class
::twt::do_request "$admin_url"
# Member management for the class
follow_members_link
# Add all students
add_members [::twt::user::get_users student] dotlrn_student_rel
# Add a random professor
add_member [::twt::user::get_random_users professor 1] dotlrn_instructor_rel
# Add two staff in random roles (one of Teaching Assistant, Course Admin, or Course Assistant)
set admin_users [::twt::user::get_random_users staff 2]
set admin_rels [list dotlrn_ta_rel dotlrn_cadmin_rel dotlrn_ca_rel]
set admin_counter 0
for { set admin_counter 0 } \
{ [expr {$admin_counter < 2 && $admin_counter < [llength $admin_users]}] } \
{ incr admin_counter } {
set admin_rel [::twt::get_random_items_from_list $admin_rels 1]
add_member [lindex $admin_users $admin_counter] $admin_rel
}
}
}
ad_proc ::twt::class::add_members { email_list rel_type } {
foreach email $email_list {
add_member $email $rel_type
}
}
ad_proc ::twt::class::add_member { email rel_type } {
if { $email eq "" } {
return
}
# Search for the student to add
form find ~a member-add
field find ~n search_text
field fill $email
form submit
# Pick the user (there should be only one)
link follow ~u member-add-2
# pick relationship type to class (role)
form find ~a "member-add-3"
::twt::multiple_select_value rel_type $rel_type
form submit
}
ad_proc ::twt::class::setup_subgroups { server_url } {
foreach admin_url [get_admin_urls] {
foreach {name description policy} [subcommunity_properties_list] {
# Admin page of one class
::twt::do_request $admin_url
# Add subcommunity form
link follow ~u subcommunity-new
form find ~n add_subcomm
field fill $name ~n pretty_name
field fill $description ~n description
::twt::multiple_select_value join_policy $policy
form submit
}
}
}
ad_proc ::twt::class::subcommunity_properties_list {} {
set property_list [list]
foreach letter {A B} {
set pretty_name "Project Group $letter"
lappend property_list $pretty_name
lappend property_list "Workspace for people working in $pretty_name"
# Other possible values: open, closed
lappend property_list "needs approval"
}
return $property_list
}
ad_proc ::twt::class::add_member_applets { server_url } {
foreach admin_url [get_admin_urls] {
# Only add the members applet to computing classes so that we can
# demo adding it to other classes manually
if { [regexp -nocase {comput} $admin_url match] } {
# Admin page of the class
::twt::do_request $admin_url
# Manage Applets
link follow ~u {applets$}
# Add the Members Info applet
link follow ~u {applet-add.*applet_key=dotlrn_members}
}
}
}
###################
#
# Namespace ::twt::class::test - no demo data setup, pure testing
#
###################
ad_proc ::twt::class::test::manage_memberships {} {
Test removing users and changing their roles in a class
using the class_url/members page.
@author Peter Marklund
} {
}
|