File:
[LON-CAPA] /
loncom /
interface /
longroup.pm
Revision
1.7:
download - view:
text,
annotated -
select for diffs
Fri Jun 30 18:27:19 2006 UTC (17 years, 10 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Moving get_bbfolder_url() and get_group_bbinfo() to longroup.pm. symb no longer needed for each bulletinboard when building links in groupboards.pm. Total number of discussion boards now displayed in view group table for each group. Also some alignment changes in this table.
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: #
26:
27: package Apache::longroup;
28:
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.
48:
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: if (my $tmp = &Apache::lonnet::error(%curr_groups)) {
74: undef(%curr_groups);
75: &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
76: }
77: return %curr_groups;
78: }
79:
80: ###############################################
81:
82: =item get_group_settings
83:
84: Uses TokeParser to extract group information from the
85: XML used to describe course groups.
86:
87: Input:
88: Scalar containing XML - as retrieved from &coursegroups().
89:
90: Output:
91: Hash containing group information as key=values for (a), and
92: hash of hashes for (b)
93:
94: Keys (in two categories):
95: (a) groupname, creator, creation, modified, startdate, enddate, quota.
96: Corresponding values are name of the group, creator of the group
97: (username:domain), UNIX time for date group was created, and
98: settings were last modified, file quota, and default start and end
99: access times for group members.
100:
101: (b) functions returned in hash of hashes.
102: Outer hash key is functions.
103: Inner hash keys are chat,discussion,email,files,homepage,roster.
104: Corresponding values are either on or off, depending on
105: whether this type of functionality is available for the group.
106:
107: =cut
108:
109: ###############################################
110:
111: sub get_group_settings {
112: my ($groupinfo)=@_;
113: my $parser=HTML::TokeParser->new(\$groupinfo);
114: my $token;
115: my $tool = '';
116: my $role = '';
117: my %content=();
118: while ($token=$parser->get_token) {
119: if ($token->[0] eq 'S') {
120: my $entry=$token->[1];
121: if ($entry eq 'functions' || $entry eq 'autosec') {
122: %{$content{$entry}} = ();
123: $tool = $entry;
124: } elsif ($entry eq 'role') {
125: if ($tool eq 'autosec') {
126: $role = $token->[2]{id};
127: @{$content{$tool}{$role}} = ();
128: }
129: } else {
130: my $value=$parser->get_text('/'.$entry);
131: if ($entry eq 'name') {
132: if ($tool eq 'functions') {
133: my $function = $token->[2]{id};
134: $content{$tool}{$function} = $value;
135: }
136: } elsif ($entry eq 'groupname') {
137: $content{$entry}=&unescape($value);
138: } elsif (($entry eq 'roles') || ($entry eq 'types') ||
139: ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
140: push(@{$content{$entry}},$value);
141: } elsif ($entry eq 'section') {
142: if ($tool eq 'autosec' && $role ne '') {
143: push(@{$content{$tool}{$role}},$value);
144: }
145: } else {
146: $content{$entry}=$value;
147: }
148: }
149: } elsif ($token->[0] eq 'E') {
150: if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
151: $tool = '';
152: } elsif ($token->[1] eq 'role') {
153: $role = '';
154: }
155: }
156: }
157: return %content;
158: }
159:
160: ###############################################
161:
162: sub check_group_access {
163: my ($group) = @_;
164: my $access = 1;
165: my $now = time;
166: my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
167: if (($end!=0) && ($end<$now)) { $access = 0; }
168: if (($start!=0) && ($start>$now)) { $access=0; }
169: return $access;
170: }
171:
172: ###############################################
173:
174: =pod
175:
176: =item group_changes
177:
178: Add or drop group memberships in a course as a result of
179: changes in a user's roles/sections. Called by
180: &Apache::lonnet:assignrole()
181:
182: Input:
183: 1. User's domain
184: 2. User's username
185: 3. Url of role
186: 4. Role
187: 5. End date of role
188: 6. Start date of role
189:
190: Checks to see if role for which assignment is being made is in a course.
191: If so, gathers information about auto-group population settings for
192: groups in the course.
193:
194: If role is being expired, will also expire any group memberships that
195: are specified for auto-group population for the specific role and
196: section (including section 'none' and 'all' sections), unless a
197: different role/section also included in auto-group population
198: for the course is included amongst the user's unexpired roles
199: and would trigger membership in teh same group(s)
200:
201: If role is being added, will add any group memberships specified
202: for auto-group population, unless use is already a group member.
203: Uses default group privileges and default start and end group access
204: times.
205:
206: Output
207: None
208:
209: Side effects:
210: May result in calls to Apache::lonnet::modify_group_roles()
211: and Apache::lonnet::modify_coursegroup_membership() to add
212: or expire group membership(s) for a user.
213:
214: =cut
215:
216: sub group_changes {
217: my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
218: my $now = time;
219: my $chgtype;
220: if ($origend > 0 && $origend <= $now) {
221: $chgtype = 'drop';
222: } else {
223: $chgtype = 'add';
224: }
225: my ($cid,$cdom,$cnum,$sec);
226: if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
227: $cid = $1;
228: $sec = $2;
229: } else {
230: $cid = $url;
231: }
232: my $courseid = $cid;
233: $courseid =~ s|^/||;
234: $courseid =~ s|/|_|;
235: my %crshash=&Apache::lonnet::coursedescription($cid);
236: $cdom = $crshash{'domain'};
237: $cnum = $crshash{'num'};
238: if (defined($cdom) && defined($cnum)) {
239: my %settings;
240: my @changegroups = ();
241: my %dropgroup = ();
242: my %dropstart = ();
243: my %addgroup = ();
244: my %curr_groups = &coursegroups($cdom,$cnum);
245: if (%curr_groups) {
246: foreach my $group (keys(%curr_groups)) {
247: %{$settings{$group}}=&get_group_settings($curr_groups{$group});
248: if ($chgtype eq 'add') {
249: if (!($settings{$group}{autoadd} eq 'on')) {
250: next;
251: }
252: } else {
253: if (!($settings{$group}{autodrop} eq 'on')) {
254: next;
255: }
256: }
257: my @autosec = ();
258: if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
259: @autosec = @{$settings{$group}{'autosec'}{$role}};
260: }
261: if ($sec eq '') {
262: $sec = 'none';
263: }
264: if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
265: push(@changegroups,$group);
266: }
267: }
268: }
269: if (@changegroups > 0) {
270: my %currpriv;
271: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
272: if (my $tmp = &Apache::lonnet::error(%roleshash)) {
273: &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
274: ' for '.$uname.':'.$udom);
275: } else {
276: my $group_privs = '';
277: foreach my $group (@changegroups) {
278: if ($chgtype eq 'add') {
279: if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
280: $group_privs =
281: join(':',@{$settings{$group}{'defpriv'}});
282: }
283: }
284: my $key = $cid.'/'.$group.'_gr';
285: if (defined($roleshash{$key})) {
286: if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
287: my $grpstart = $3;
288: my $grpend = $2;
289: $currpriv{$group} = $1;
290: if ($chgtype eq 'drop') {
291: if ($grpstart == -1) { next; } # deleted
292: if ($grpend == 0 || $grpend > $now) {
293: if (!defined($dropgroup{$group})) {
294: $dropstart{$group} = $grpstart;
295: if ($grpstart > $now) {
296: $dropstart{$group} = $now;
297: }
298: $dropgroup{$group} = $now.':'.
299: $dropstart{$group}.
300: ':'.$currpriv{$group};
301: }
302: }
303: } elsif ($chgtype eq 'add') {
304: if (($grpstart == -1) || ($grpend > 0 &&
305: ($grpend < $settings{$group}{'enddate'} ||
306: $settings{$group}{'enddate'} == 0)) ||
307: ($grpstart > $settings{$group}{'startdate'})) {
308: if (!defined($addgroup{$group})) {
309: $addgroup{$group} =
310: $settings{$group}{'enddate'}.':'.
311: $settings{$group}{'startdate'}.':'.
312: $group_privs;
313: }
314: }
315: }
316: }
317: } elsif ($chgtype eq 'add') {
318: $addgroup{$group} = $settings{$group}{'enddate'}.':'.
319: $settings{$group}{'startdate'}.':'.
320: $group_privs;
321: }
322: }
323: if ($chgtype eq 'add') {
324: foreach my $add (keys(%addgroup)) {
325: if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
326: $add,$uname.':'.$udom,
327: $settings{$add}{'enddate'},
328: $settings{$add}{'startdate'},
329: $group_privs) eq 'ok') {
330: my %usersettings;
331: $usersettings{$add.':'.$uname.':'.$udom} =
332: $addgroup{$add};
333: my $roster_result =
334: &Apache::lonnet::modify_coursegroup_membership(
335: $cdom,$cnum,\%usersettings);
336: }
337: }
338: } elsif ($chgtype eq 'drop') {
339: foreach my $drop (keys(%dropgroup)) {
340: my $nodrop = 0;
341: if ($settings{$drop}{'autoadd'} eq 'on') {
342: foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
343: if ($nodrop) {
344: last;
345: } else {
346: my @autosec = ();
347: if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
348: @autosec = @{$settings{$drop}{'autosec'}{$urole}};
349: }
350: foreach my $usec (@autosec) {
351: if ($usec eq 'all') {
352: foreach my $ukey (keys(%roleshash)) {
353: if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
354: if ($sec ne $1) {
355: if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
356: my $roleend = $1;
357: if ((!$roleend) ||
358: ($roleend > $now)) {
359: $nodrop = 1;
360: last;
361: }
362: }
363: }
364: }
365: }
366: } else {
367: my $ukey = $cid.'/'.$usec.'_'.$urole;
368: if ($usec eq 'none') {
369: if ($sec eq '') {
370: next;
371: }
372: } else {
373: if ($usec eq $sec) {
374: next;
375: }
376: }
377: if (exists($roleshash{$ukey})) {
378: if ($roleshash{$ukey} =~
379: /_?(\d*)_?([\-\d]*)$/) {
380: my $roleend = $1;
381: if ((!$roleend) ||
382: ($roleend > $now)) {
383: $nodrop = 1;
384: last;
385: }
386: }
387: }
388: }
389: }
390: }
391: }
392: }
393: if (!$nodrop) {
394: if (&Apache::lonnet::modify_group_roles($cdom,
395: $cnum,$drop,
396: $uname.':'.$udom,$now,
397: $dropstart{$drop},
398: $currpriv{$drop})
399: eq 'ok') {
400: my %usersettings;
401: $usersettings{$drop.':'.$uname.':'.$udom} =
402: $dropgroup{$drop};
403: my $roster_result =
404: &Apache::lonnet::modify_coursegroup_membership(
405: $cdom,$cnum,\%usersettings);
406: }
407: }
408: }
409: }
410: }
411: }
412: }
413: return;
414: }
415:
416: ###############################################
417:
418: sub sum_quotas {
419: my ($courseid) = @_;
420: my $totalquotas = 0;
421: my ($cdom,$cnum);
422: if (!defined($courseid)) {
423: if (defined($env{'request.course.id'})) {
424: $courseid = $env{'request.course.id'};
425: $cdom = $env{'course.'.$courseid.'.domain'};
426: $cnum = $env{'course.'.$courseid.'.num'};
427: } else {
428: return '';
429: }
430: } else {
431: ($cdom,$cnum) = split(/_/,$courseid);
432: }
433: if ($cdom && $cnum) {
434: my %curr_groups = &coursegroups($cdom,$cnum);
435: if (%curr_groups) {
436: foreach my $group (keys(%curr_groups)) {
437: my %settings=&get_group_settings($curr_groups{$group});
438: my $quota = $settings{'quota'};
439: if ($quota eq '') {
440: $quota = 0;
441: }
442: $totalquotas += $quota;
443: }
444: } else {
445: return 0;
446: }
447: } else {
448: return '';
449: }
450: return $totalquotas;
451: }
452:
453: ###############################################
454:
455: sub get_bbfolder_url {
456: my ($cdom,$cnum,$group) = @_;
457: my %curr_groups = &coursegroups($cdom,$cnum,$group);
458: my $grpbbmap;
459: if (%curr_groups) {
460: my %group_info = &get_group_settings($curr_groups{$group});
461: my $creation = $group_info{'creation'};
462: my $bbfolder = $creation + 1;
463: my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
464: $grpbbmap = $crspath.'default_'.$bbfolder.'.sequence';
465: }
466: return $grpbbmap;
467: }
468:
469: ###############################################
470:
471: sub get_group_bbinfo {
472: my ($cdom,$cnum,$group) = @_;
473: my $navmap = Apache::lonnavmaps::navmap->new();
474: my @groupboards;
475: my %boardshash;
476: my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
477: if ($grpbbmap) {
478: my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
479: if ($bbfolderres) {
480: my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
481: foreach my $res (@boards) {
482: my $url = $res->src();
483: if ($url =~ m|^/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard|) {
484: push(@groupboards,$res->symb());
485: $boardshash{$res->symb()} = {
486: title => $res->title(),
487: url => $res->src(),
488: };
489: }
490: }
491: }
492: }
493: undef($navmap);
494: return (\@groupboards,\%boardshash);
495: }
496:
497: ###############################################
498:
499: 1;
500:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>