![[BACK]](/icons/back.gif){kind=icon}
Return to longroup.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface|
Return to longroup.pm CVS log | Up to [LON-CAPA] / loncom / interface |
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # accessor routines used to provide information about course groups
3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
1.4 ! albertel 26:
1.1 raeburn 27: package Apache::longroup;
1.4 ! albertel 28:
1.1 raeburn 29: use strict;
30: use Apache::lonnet;
31:
32: ###############################################
33: =pod
34:
35: =item coursegroups
36:
37: Retrieve information about groups in a course,
38:
39: Input:
40: 1. Optional course domain
41: 2. Optional course number
42: 3. Optional group name
43:
44: Course domain and number will be taken from user's
45: environment if not supplied. Optional group name will
46: be passed to lonnet::get_coursegroups() as a regexp to
47: use in the call to the dump function.
1.4 ! albertel 48:
1.1 raeburn 49: Output
50: Returns hash of groups in the course (subject to the
51: optional group name filter). In the hash, the keys are
52: group names, and their corresponding values
53: are scalars containing group information in XML. This
54: can be sent to &get_group_settings() to be parsed.
55:
56: Side effects:
57: None.
58: =cut
59:
60: ###############################################
61:
62: sub coursegroups {
63: my ($cdom,$cnum,$group) = @_;
64: if (!defined($cdom) || !defined($cnum)) {
65: my $cid = $env{'request.course.id'};
66:
67: return if (!defined($cid));
68:
69: $cdom = $env{'course.'.$cid.'.domain'};
70: $cnum = $env{'course.'.$cid.'.num'};
71: }
72: my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
73: my ($tmp) = keys(%curr_groups);
74: if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) {
75: undef(%curr_groups);
1.3 albertel 76: &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
1.1 raeburn 77: } elsif ($tmp=~/^error: 2 /) {
78: undef(%curr_groups);
79: }
80: return %curr_groups;
81: }
82:
83: ###############################################
84:
85: =item get_group_settings
1.4 ! albertel 86:
1.1 raeburn 87: Uses TokeParser to extract group information from the
88: XML used to describe course groups.
1.4 ! albertel 89:
1.1 raeburn 90: Input:
91: Scalar containing XML - as retrieved from &coursegroups().
1.4 ! albertel 92:
1.1 raeburn 93: Output:
94: Hash containing group information as key=values for (a), and
95: hash of hashes for (b)
1.4 ! albertel 96:
1.1 raeburn 97: Keys (in two categories):
98: (a) groupname, creator, creation, modified, startdate,enddate.
99: Corresponding values are name of the group, creator of the group
100: (username:domain), UNIX time for date group was created, and
101: settings were last modified, and default start and end access
102: times for group members.
1.4 ! albertel 103:
1.1 raeburn 104: (b) functions returned in hash of hashes.
105: Outer hash key is functions.
106: Inner hash keys are chat,discussion,email,files,homepage,roster.
107: Corresponding values are either on or off, depending on
108: whether this type of functionality is available for the group.
1.4 ! albertel 109:
1.1 raeburn 110: =cut
111:
112: ###############################################
113:
114: sub get_group_settings {
115: my ($groupinfo)=@_;
116: my $parser=HTML::TokeParser->new(\$groupinfo);
117: my $token;
118: my $tool = '';
119: my $role = '';
120: my %content=();
121: while ($token=$parser->get_token) {
122: if ($token->[0] eq 'S') {
123: my $entry=$token->[1];
124: if ($entry eq 'functions' || $entry eq 'autosec') {
125: %{$content{$entry}} = ();
126: $tool = $entry;
127: } elsif ($entry eq 'role') {
128: if ($tool eq 'autosec') {
129: $role = $token->[2]{id};
130: @{$content{$tool}{$role}} = ();
131: }
132: } else {
133: my $value=$parser->get_text('/'.$entry);
134: if ($entry eq 'name') {
135: if ($tool eq 'functions') {
136: my $function = $token->[2]{id};
137: $content{$tool}{$function} = $value;
138: }
139: } elsif ($entry eq 'groupname') {
140: $content{$entry}=&unescape($value);
141: } elsif (($entry eq 'roles') || ($entry eq 'types') ||
142: ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
143: push(@{$content{$entry}},$value);
144: } elsif ($entry eq 'section') {
145: if ($tool eq 'autosec' && $role ne '') {
146: push(@{$content{$tool}{$role}},$value);
147: }
148: } else {
149: $content{$entry}=$value;
150: }
151: }
152: } elsif ($token->[0] eq 'E') {
153: if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
154: $tool = '';
155: } elsif ($token->[1] eq 'role') {
156: $role = '';
157: }
158: }
159: }
160: return %content;
161: }
162:
163: ###############################################
164:
165: sub check_group_access {
166: my ($group) = @_;
167: my $access = 1;
168: my $now = time;
169: my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
170: if (($end!=0) && ($end<$now)) { $access = 0; }
171: if (($start!=0) && ($start>$now)) { $access=0; }
172: return $access;
173: }
174:
175: ###############################################
176:
177: =pod
1.4 ! albertel 178:
1.1 raeburn 179: =item group_changes
180:
181: Add or drop group memberships in a course as a result of
182: changes in a user's roles/sections. Called by
183: &Apache::lonnet:assignrole()
1.4 ! albertel 184:
1.1 raeburn 185: Input:
186: 1. User's domain
187: 2. User's username
188: 3. Url of role
189: 4. Role
190: 5. End date of role
191: 6. Start date of role
192:
193: Checks to see if role for which assignment is being made is in a course.
194: If so, gathers information about auto-group population settings for
195: groups in the course.
196:
197: If role is being expired, will also expire any group memberships that
198: are specified for auto-group population for the specific role and
199: section (including section 'none' and 'all' sections), unless a
200: different role/section also included in auto-group population
201: for the course is included amongst the user's unexpired roles
202: and would trigger membership in teh same group(s)
203:
204: If role is being added, will add any group memberships specified
205: for auto-group population, unless use is already a group member.
206: Uses default group privileges and default start and end group access
207: times.
208:
209: Output
210: None
211:
212: Side effects:
213: May result in calls to Apache::lonnet::modify_group_roles()
214: and Apache::lonnet::modify_coursegroup_membership() to add
215: or expire group membership(s) for a user.
216:
217: =cut
218:
219: sub group_changes {
220: my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
221: my $now = time;
222: my $chgtype;
223: if ($origend > 0 && $origend <= $now) {
224: $chgtype = 'drop';
225: } else {
226: $chgtype = 'add';
227: }
228: my ($cid,$cdom,$cnum,$sec);
229: if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
230: $cid = $1;
231: $sec = $2;
232: } else {
233: $cid = $url;
234: }
235: my $courseid = $cid;
236: $courseid =~ s|^/||;
237: $courseid =~ s|/|_|;
238: my %crshash=&Apache::lonnet::coursedescription($cid);
239: $cdom = $crshash{'domain'};
240: $cnum = $crshash{'num'};
241: if (defined($cdom) && defined($cnum)) {
242: my %settings;
243: my @changegroups = ();
244: my %dropgroup = ();
245: my %dropstart = ();
246: my %addgroup = ();
247: my %curr_groups = &coursegroups($cdom,$cnum);
248: if (%curr_groups) {
249: foreach my $group (keys(%curr_groups)) {
250: %{$settings{$group}}=&get_group_settings($curr_groups{$group});
251: if ($chgtype eq 'add') {
252: if (!($settings{$group}{autoadd} eq 'on')) {
253: next;
254: }
255: } else {
256: if (!($settings{$group}{autodrop} eq 'on')) {
257: next;
258: }
259: }
260: my @autosec = ();
261: if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
262: @autosec = @{$settings{$group}{'autosec'}{$role}};
263: }
264: if ($sec eq '') {
265: $sec = 'none';
266: }
267: if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
268: push(@changegroups,$group);
269: }
270: }
271: }
272: if (@changegroups > 0) {
273: my %currpriv;
274: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
275: my ($tmp) = keys(%roleshash);
276: if ($tmp=~/^error:/) {
277: &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
278: ' for '.$uname.':'.$udom);
279: } else {
280: my $group_privs = '';
281: foreach my $group (@changegroups) {
282: if ($chgtype eq 'add') {
283: if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
284: $group_privs =
285: join(':',@{$settings{$group}{'defpriv'}});
286: }
287: }
288: my $key = $cid.'/'.$group.'_gr';
289: if (defined($roleshash{$key})) {
290: if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
291: my $grpstart = $3;
292: my $grpend = $2;
293: $currpriv{$group} = $1;
294: if ($chgtype eq 'drop') {
295: if ($grpstart == -1) { next; } # deleted
296: if ($grpend == 0 || $grpend > $now) {
1.2 albertel 297: if (!defined($dropgroup{$group})) {
1.1 raeburn 298: $dropstart{$group} = $grpstart;
299: if ($grpstart > $now) {
300: $dropstart{$group} = $now;
301: }
302: $dropgroup{$group} = $now.':'.
303: $dropstart{$group}.
304: ':'.$currpriv{$group};
305: }
306: }
307: } elsif ($chgtype eq 'add') {
308: if (($grpstart == -1) || ($grpend > 0 &&
309: ($grpend < $settings{$group}{'enddate'} ||
310: $settings{$group}{'enddate'} == 0)) ||
311: ($grpstart > $settings{$group}{'startdate'})) {
1.2 albertel 312: if (!defined($addgroup{$group})) {
1.1 raeburn 313: $addgroup{$group} =
314: $settings{$group}{'enddate'}.':'.
315: $settings{$group}{'startdate'}.':'.
316: $group_privs;
317: }
318: }
319: }
320: }
321: } elsif ($chgtype eq 'add') {
322: $addgroup{$group} = $settings{$group}{'enddate'}.':'.
323: $settings{$group}{'startdate'}.':'.
324: $group_privs;
325: }
326: }
327: if ($chgtype eq 'add') {
328: foreach my $add (keys(%addgroup)) {
329: if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
330: $add,$uname.':'.$udom,
331: $settings{$add}{'enddate'},
332: $settings{$add}{'startdate'},
333: $group_privs) eq 'ok') {
334: my %usersettings;
335: $usersettings{$add.':'.$uname.':'.$udom} =
336: $addgroup{$add};
337: my $roster_result =
338: &Apache::lonnet::modify_coursegroup_membership(
339: $cdom,$cnum,\%usersettings);
340: }
341: }
342: } elsif ($chgtype eq 'drop') {
343: foreach my $drop (keys(%dropgroup)) {
344: my $nodrop = 0;
345: if ($settings{$drop}{'autoadd'} eq 'on') {
346: foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
347: if ($nodrop) {
348: last;
349: } else {
350: my @autosec = ();
351: if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
352: @autosec = @{$settings{$drop}{'autosec'}{$urole}};
353: }
354: foreach my $usec (@autosec) {
355: if ($usec eq 'all') {
356: foreach my $ukey (keys(%roleshash)) {
357: if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
1.2 albertel 358: if ($sec ne $1) {
1.1 raeburn 359: if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
360: my $roleend = $1;
361: if ((!$roleend) ||
362: ($roleend > $now)) {
363: $nodrop = 1;
364: last;
365: }
366: }
367: }
368: }
369: }
370: } else {
371: my $ukey = $cid.'/'.$usec.'_'.$urole;
372: if ($usec eq 'none') {
373: if ($sec eq '') {
374: next;
375: }
376: } else {
377: if ($usec eq $sec) {
378: next;
379: }
380: }
381: if (exists($roleshash{$ukey})) {
382: if ($roleshash{$ukey} =~
383: /_?(\d*)_?([\-\d]*)$/) {
384: my $roleend = $1;
385: if ((!$roleend) ||
386: ($roleend > $now)) {
387: $nodrop = 1;
388: last;
389: }
390: }
391: }
392: }
393: }
394: }
395: }
396: }
397: if (!$nodrop) {
398: if (&Apache::lonnet::modify_group_roles($cdom,
399: $cnum,$drop,
400: $uname.':'.$udom,$now,
401: $dropstart{$drop},
402: $currpriv{$drop})
403: eq 'ok') {
404: my %usersettings;
405: $usersettings{$drop.':'.$uname.':'.$udom} =
406: $dropgroup{$drop};
407: my $roster_result =
408: &Apache::lonnet::modify_coursegroup_membership(
409: $cdom,$cnum,\%usersettings);
410: }
411: }
412: }
413: }
414: }
415: }
416: }
417: return;
418: }
419:
420: ###############################################
421:
422: 1;
423: