![[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
1.13 raeburn 43: 4. Optional namespace
1.1 raeburn 44:
45: Course domain and number will be taken from user's
46: environment if not supplied. Optional group name will
1.13 raeburn 47: be passed to lonnet function as a regexp to
48: use in the call to the dump function. Optional namespace
49: will determine whether information is retrieved about current
50: groups (default) or deleted groups (namespace = deleted_groups).
1.4 albertel 51:
1.1 raeburn 52: Output
1.13 raeburn 53: Returns hash of groups in a course (subject to the
1.1 raeburn 54: optional group name filter). In the hash, the keys are
55: group names, and their corresponding values
56: are scalars containing group information in XML. This
57: can be sent to &get_group_settings() to be parsed.
58:
59: Side effects:
60: None.
61: =cut
62:
63: ###############################################
64:
65: sub coursegroups {
1.13 raeburn 66: my ($cdom,$cnum,$group,$namespace) = @_;
1.1 raeburn 67: if (!defined($cdom) || !defined($cnum)) {
68: my $cid = $env{'request.course.id'};
69:
70: return if (!defined($cid));
71:
72: $cdom = $env{'course.'.$cid.'.domain'};
73: $cnum = $env{'course.'.$cid.'.num'};
74: }
1.13 raeburn 75: if (!defined($namespace)) {
76: $namespace = 'coursegroups';
77: }
78: my %groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group,
79: $namespace);
80: if (my $tmp = &Apache::lonnet::error(%groups)) {
81: undef(%groups);
82: &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom.' - '.$namespace);
1.1 raeburn 83: }
1.14 ! raeburn 84: if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
! 85: delete($groups{'group_allfolders'."\0".'locked_folder'});
! 86: }
1.13 raeburn 87: return %groups;
1.1 raeburn 88: }
89:
90: ###############################################
91:
92: =item get_group_settings
1.4 albertel 93:
1.1 raeburn 94: Uses TokeParser to extract group information from the
95: XML used to describe course groups.
1.4 albertel 96:
1.1 raeburn 97: Input:
98: Scalar containing XML - as retrieved from &coursegroups().
1.4 albertel 99:
1.1 raeburn 100: Output:
101: Hash containing group information as key=values for (a), and
102: hash of hashes for (b)
1.4 albertel 103:
1.1 raeburn 104: Keys (in two categories):
1.6 raeburn 105: (a) groupname, creator, creation, modified, startdate, enddate, quota.
1.1 raeburn 106: Corresponding values are name of the group, creator of the group
107: (username:domain), UNIX time for date group was created, and
1.6 raeburn 108: settings were last modified, file quota, and default start and end
109: access times for group members.
1.4 albertel 110:
1.1 raeburn 111: (b) functions returned in hash of hashes.
112: Outer hash key is functions.
113: Inner hash keys are chat,discussion,email,files,homepage,roster.
114: Corresponding values are either on or off, depending on
115: whether this type of functionality is available for the group.
1.4 albertel 116:
1.1 raeburn 117: =cut
118:
119: ###############################################
120:
121: sub get_group_settings {
122: my ($groupinfo)=@_;
123: my $parser=HTML::TokeParser->new(\$groupinfo);
124: my $token;
125: my $tool = '';
126: my $role = '';
127: my %content=();
128: while ($token=$parser->get_token) {
129: if ($token->[0] eq 'S') {
130: my $entry=$token->[1];
131: if ($entry eq 'functions' || $entry eq 'autosec') {
132: %{$content{$entry}} = ();
133: $tool = $entry;
134: } elsif ($entry eq 'role') {
135: if ($tool eq 'autosec') {
136: $role = $token->[2]{id};
137: @{$content{$tool}{$role}} = ();
138: }
139: } else {
140: my $value=$parser->get_text('/'.$entry);
141: if ($entry eq 'name') {
142: if ($tool eq 'functions') {
143: my $function = $token->[2]{id};
144: $content{$tool}{$function} = $value;
145: }
146: } elsif ($entry eq 'groupname') {
147: $content{$entry}=&unescape($value);
148: } elsif (($entry eq 'roles') || ($entry eq 'types') ||
149: ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
150: push(@{$content{$entry}},$value);
151: } elsif ($entry eq 'section') {
152: if ($tool eq 'autosec' && $role ne '') {
153: push(@{$content{$tool}{$role}},$value);
154: }
155: } else {
156: $content{$entry}=$value;
157: }
158: }
159: } elsif ($token->[0] eq 'E') {
160: if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
161: $tool = '';
162: } elsif ($token->[1] eq 'role') {
163: $role = '';
164: }
165: }
166: }
167: return %content;
168: }
169:
170: ###############################################
171:
172: sub check_group_access {
173: my ($group) = @_;
174: my $access = 1;
175: my $now = time;
176: my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
177: if (($end!=0) && ($end<$now)) { $access = 0; }
178: if (($start!=0) && ($start>$now)) { $access=0; }
179: return $access;
180: }
181:
182: ###############################################
183:
184: =pod
1.4 albertel 185:
1.1 raeburn 186: =item group_changes
187:
188: Add or drop group memberships in a course as a result of
189: changes in a user's roles/sections. Called by
190: &Apache::lonnet:assignrole()
1.4 albertel 191:
1.1 raeburn 192: Input:
193: 1. User's domain
194: 2. User's username
195: 3. Url of role
196: 4. Role
197: 5. End date of role
198: 6. Start date of role
199:
200: Checks to see if role for which assignment is being made is in a course.
201: If so, gathers information about auto-group population settings for
202: groups in the course.
203:
204: If role is being expired, will also expire any group memberships that
205: are specified for auto-group population for the specific role and
206: section (including section 'none' and 'all' sections), unless a
207: different role/section also included in auto-group population
208: for the course is included amongst the user's unexpired roles
209: and would trigger membership in teh same group(s)
210:
211: If role is being added, will add any group memberships specified
212: for auto-group population, unless use is already a group member.
213: Uses default group privileges and default start and end group access
214: times.
215:
216: Output
217: None
218:
219: Side effects:
220: May result in calls to Apache::lonnet::modify_group_roles()
221: and Apache::lonnet::modify_coursegroup_membership() to add
222: or expire group membership(s) for a user.
223:
224: =cut
225:
226: sub group_changes {
227: my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
228: my $now = time;
229: my $chgtype;
230: if ($origend > 0 && $origend <= $now) {
231: $chgtype = 'drop';
232: } else {
233: $chgtype = 'add';
234: }
235: my ($cid,$cdom,$cnum,$sec);
236: if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
237: $cid = $1;
238: $sec = $2;
239: } else {
240: $cid = $url;
241: }
242: my $courseid = $cid;
243: $courseid =~ s|^/||;
244: $courseid =~ s|/|_|;
245: my %crshash=&Apache::lonnet::coursedescription($cid);
246: $cdom = $crshash{'domain'};
247: $cnum = $crshash{'num'};
248: if (defined($cdom) && defined($cnum)) {
249: my %settings;
250: my @changegroups = ();
251: my %dropgroup = ();
252: my %dropstart = ();
253: my %addgroup = ();
254: my %curr_groups = &coursegroups($cdom,$cnum);
255: if (%curr_groups) {
256: foreach my $group (keys(%curr_groups)) {
257: %{$settings{$group}}=&get_group_settings($curr_groups{$group});
258: if ($chgtype eq 'add') {
259: if (!($settings{$group}{autoadd} eq 'on')) {
260: next;
261: }
262: } else {
263: if (!($settings{$group}{autodrop} eq 'on')) {
264: next;
265: }
266: }
267: my @autosec = ();
268: if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
269: @autosec = @{$settings{$group}{'autosec'}{$role}};
270: }
271: if ($sec eq '') {
272: $sec = 'none';
273: }
274: if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
275: push(@changegroups,$group);
276: }
277: }
278: }
279: if (@changegroups > 0) {
280: my %currpriv;
281: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
1.5 albertel 282: if (my $tmp = &Apache::lonnet::error(%roleshash)) {
1.1 raeburn 283: &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
284: ' for '.$uname.':'.$udom);
285: } else {
286: my $group_privs = '';
287: foreach my $group (@changegroups) {
288: if ($chgtype eq 'add') {
289: if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
290: $group_privs =
291: join(':',@{$settings{$group}{'defpriv'}});
292: }
293: }
294: my $key = $cid.'/'.$group.'_gr';
295: if (defined($roleshash{$key})) {
296: if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
297: my $grpstart = $3;
298: my $grpend = $2;
299: $currpriv{$group} = $1;
300: if ($chgtype eq 'drop') {
301: if ($grpstart == -1) { next; } # deleted
302: if ($grpend == 0 || $grpend > $now) {
1.2 albertel 303: if (!defined($dropgroup{$group})) {
1.1 raeburn 304: $dropstart{$group} = $grpstart;
305: if ($grpstart > $now) {
306: $dropstart{$group} = $now;
307: }
308: $dropgroup{$group} = $now.':'.
309: $dropstart{$group}.
310: ':'.$currpriv{$group};
311: }
312: }
313: } elsif ($chgtype eq 'add') {
314: if (($grpstart == -1) || ($grpend > 0 &&
315: ($grpend < $settings{$group}{'enddate'} ||
316: $settings{$group}{'enddate'} == 0)) ||
317: ($grpstart > $settings{$group}{'startdate'})) {
1.2 albertel 318: if (!defined($addgroup{$group})) {
1.1 raeburn 319: $addgroup{$group} =
320: $settings{$group}{'enddate'}.':'.
321: $settings{$group}{'startdate'}.':'.
322: $group_privs;
323: }
324: }
325: }
326: }
327: } elsif ($chgtype eq 'add') {
328: $addgroup{$group} = $settings{$group}{'enddate'}.':'.
329: $settings{$group}{'startdate'}.':'.
330: $group_privs;
331: }
332: }
333: if ($chgtype eq 'add') {
334: foreach my $add (keys(%addgroup)) {
335: if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
336: $add,$uname.':'.$udom,
337: $settings{$add}{'enddate'},
338: $settings{$add}{'startdate'},
339: $group_privs) eq 'ok') {
340: my %usersettings;
341: $usersettings{$add.':'.$uname.':'.$udom} =
342: $addgroup{$add};
343: my $roster_result =
344: &Apache::lonnet::modify_coursegroup_membership(
345: $cdom,$cnum,\%usersettings);
346: }
347: }
348: } elsif ($chgtype eq 'drop') {
349: foreach my $drop (keys(%dropgroup)) {
350: my $nodrop = 0;
351: if ($settings{$drop}{'autoadd'} eq 'on') {
352: foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
353: if ($nodrop) {
354: last;
355: } else {
356: my @autosec = ();
357: if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
358: @autosec = @{$settings{$drop}{'autosec'}{$urole}};
359: }
360: foreach my $usec (@autosec) {
361: if ($usec eq 'all') {
362: foreach my $ukey (keys(%roleshash)) {
363: if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
1.2 albertel 364: if ($sec ne $1) {
1.1 raeburn 365: if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
366: my $roleend = $1;
367: if ((!$roleend) ||
368: ($roleend > $now)) {
369: $nodrop = 1;
370: last;
371: }
372: }
373: }
374: }
375: }
376: } else {
377: my $ukey = $cid.'/'.$usec.'_'.$urole;
378: if ($usec eq 'none') {
379: if ($sec eq '') {
380: next;
381: }
382: } else {
383: if ($usec eq $sec) {
384: next;
385: }
386: }
387: if (exists($roleshash{$ukey})) {
388: if ($roleshash{$ukey} =~
389: /_?(\d*)_?([\-\d]*)$/) {
390: my $roleend = $1;
391: if ((!$roleend) ||
392: ($roleend > $now)) {
393: $nodrop = 1;
394: last;
395: }
396: }
397: }
398: }
399: }
400: }
401: }
402: }
403: if (!$nodrop) {
404: if (&Apache::lonnet::modify_group_roles($cdom,
405: $cnum,$drop,
406: $uname.':'.$udom,$now,
407: $dropstart{$drop},
408: $currpriv{$drop})
409: eq 'ok') {
410: my %usersettings;
411: $usersettings{$drop.':'.$uname.':'.$udom} =
412: $dropgroup{$drop};
413: my $roster_result =
414: &Apache::lonnet::modify_coursegroup_membership(
415: $cdom,$cnum,\%usersettings);
416: }
417: }
418: }
419: }
420: }
421: }
422: }
423: return;
424: }
425:
426: ###############################################
427:
1.8 raeburn 428: sub get_fixed_privs {
429: my $fixedprivs = {
430: email => {sgm => 1},
431: discussion => {vgb => 1},
432: chat => {pgc => 1},
433: files => {rgf => 1},
434: roster => {vgm => 1},
435: homepage => {vgh => 1},
436: };
437: return $fixedprivs;
438: }
439:
440: ###############################################
441:
442: sub get_tool_privs {
443: my ($gpterm) = @_;
444: my $toolprivs = {
445: email => {
446: sgm => 'Send '.$gpterm.' mail',
447: sgb => 'Broadcast mail',
448: },
449: discussion => {
450: cgb => 'Create boards',
451: pgd => 'Post',
1.10 raeburn 452: egp => 'Edit own posts',
453: dgp => 'Hide/Delete any post',
1.8 raeburn 454: vgb => 'View boards',
455: },
456: chat => {
457: pgc => 'Chat',
458: },
459: files => {
460: rgf => 'Retrieve',
461: ugf => 'Upload',
462: mgf => 'Modify',
463: dgf => 'Delete',
464: agf => 'Control Access',
465: },
466: roster => {
1.10 raeburn 467: vgm => 'Basic Display',
468: vmd => 'Detailed Display',
1.8 raeburn 469: },
470: homepage => {
471: vgh => 'View page',
472: mgh => 'Modify page',
473: },
474: };
475: return $toolprivs;
476: }
477:
478: ###############################################
479:
480:
481: sub group_memberlist {
482: my ($cdom,$cnum,$groupname,$fixedprivs,$available) = @_;
483: my %membership = &Apache::lonnet::get_group_membership($cdom,$cnum,
484: $groupname);
485: my %current = ();
486: my $hastools = 0;
487: my $addtools = 0;
1.9 raeburn 488: my %member_nums = (
489: 'previous' => 0,
490: 'future' => 0,
491: 'active' => 0,
492: );
1.8 raeburn 493: my $now = time;
494: if (keys(%membership) > 0) {
495: my %allnames = ();
496: foreach my $key (sort(keys(%membership))) {
497: if ($key =~ /^\Q$groupname\E:([^:]+):([^:]+)$/) {
498: my $uname = $1;
499: my $udom = $2;
500: my $user = $uname.':'.$udom;
501: my($end,$start,@userprivs) = split(/:/,$membership{$key});
502: unless ($start == -1) {
503: $allnames{$udom}{$uname} = 1;
504: $current{$user} = {
505: uname => $uname,
506: udom => $udom,
507: start => &Apache::lonlocal::locallocaltime($start),
508: currtools => [],
509: newtools => [],
510: privs => \@userprivs,
511: };
512:
513: if ($end == 0) {
514: $current{$user}{end} = 'No end date';
515: } else {
516: $current{$user}{end} =
517: &Apache::lonlocal::locallocaltime($end);
518: }
519: my $now = time;
520: if (($end > 0) && ($end < $now)) {
521: $current{$user}{changestate} = 'reenable';
522: $current{$user}{'status'} = 'previous';
1.9 raeburn 523: $member_nums{'previous'} ++;
1.8 raeburn 524: } elsif (($start > $now)) {
525: $current{$user}{changestate} = 'activate';
526: $current{$user}{'status'} = 'future';
1.9 raeburn 527: $member_nums{'future'} ++;
1.8 raeburn 528: } else {
529: $current{$user}{changestate} = 'expire';
530: $current{$user}{'status'} = 'active';
1.9 raeburn 531: $member_nums{'active'} ++;
1.8 raeburn 532: }
1.10 raeburn 533: if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
1.8 raeburn 534: foreach my $tool (sort(keys(%{$fixedprivs}))) {
535: foreach my $priv (keys(%{$$fixedprivs{$tool}})) {
536: if (grep/^$priv$/,@userprivs) {
537: push(@{$current{$user}{currtools}},$tool);
538: last;
539: }
540: }
541: }
542: $hastools = 1;
543: }
1.10 raeburn 544: if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
1.8 raeburn 545: if (@{$current{$user}{currtools}} > 0) {
546: if ("@{$available}" ne "@{$current{$user}{currtools}}") {
547: foreach my $tool (@{$available}) {
548: unless (grep/^$tool$/,@{$current{$user}{currtools}}) {
549: push(@{$current{$user}{newtools}},$tool); }
550: }
551: }
552: } else {
553: @{$current{$user}{newtools}} = @{$available};
554:
555: }
556: if (@{$current{$user}{newtools}} > 0) {
557: $addtools = 1;
558: }
559: }
560: }
561: }
562: }
563: if (keys(%current) > 0) {
564: my %idhash;
565: foreach my $udom (keys(%allnames)) {
566: %{$idhash{$udom}} = &Apache::lonnet::idrget($udom,
567: keys(%{$allnames{$udom}}));
568: foreach my $uname (keys(%{$idhash{$udom}})) {
569: $current{$uname.':'.$udom}{'id'} = $idhash{$udom}{$uname};
570: }
571: foreach my $uname (keys(%{$allnames{$udom}})) {
572: $current{$uname.':'.$udom}{'fullname'} =
573: &Apache::loncommon::plainname($uname,$udom,
574: 'lastname');
575: }
576: }
577: }
578: }
1.10 raeburn 579: return (\%current,\%member_nums,$hastools,$addtools);
1.8 raeburn 580: }
581:
582: ###############################################
583:
1.6 raeburn 584: sub sum_quotas {
585: my ($courseid) = @_;
586: my $totalquotas = 0;
587: my ($cdom,$cnum);
588: if (!defined($courseid)) {
589: if (defined($env{'request.course.id'})) {
590: $courseid = $env{'request.course.id'};
591: $cdom = $env{'course.'.$courseid.'.domain'};
592: $cnum = $env{'course.'.$courseid.'.num'};
593: } else {
594: return '';
595: }
596: } else {
597: ($cdom,$cnum) = split(/_/,$courseid);
598: }
599: if ($cdom && $cnum) {
600: my %curr_groups = &coursegroups($cdom,$cnum);
601: if (%curr_groups) {
602: foreach my $group (keys(%curr_groups)) {
603: my %settings=&get_group_settings($curr_groups{$group});
604: my $quota = $settings{'quota'};
605: if ($quota eq '') {
606: $quota = 0;
607: }
608: $totalquotas += $quota;
609: }
610: } else {
611: return 0;
612: }
613: } else {
614: return '';
615: }
616: return $totalquotas;
617: }
618:
619: ###############################################
620:
1.7 raeburn 621: sub get_bbfolder_url {
622: my ($cdom,$cnum,$group) = @_;
623: my %curr_groups = &coursegroups($cdom,$cnum,$group);
624: my $grpbbmap;
625: if (%curr_groups) {
626: my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
1.9 raeburn 627: $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
1.7 raeburn 628: }
629: return $grpbbmap;
630: }
631:
632: ###############################################
633:
634: sub get_group_bbinfo {
1.10 raeburn 635: my ($cdom,$cnum,$group,$boardurl) = @_;
1.7 raeburn 636: my $navmap = Apache::lonnavmaps::navmap->new();
637: my @groupboards;
638: my %boardshash;
639: my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
640: if ($grpbbmap) {
641: my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
642: if ($bbfolderres) {
643: my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
644: foreach my $res (@boards) {
645: my $url = $res->src();
1.10 raeburn 646: if ($url =~ m|^(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
647: if ($boardurl) {
648: if ($boardurl =~ /^\Q$1\E/) {
649: push(@groupboards,$res->symb());
650: $boardshash{$res->symb()} = {
651: title => $res->title(),
652: url => $res->src(),
653: };
654: last;
655: }
656: } else {
657: push(@groupboards,$res->symb());
658: $boardshash{$res->symb()} = {
659: title => $res->title(),
660: url => $res->src(),
661: };
662: }
1.7 raeburn 663: }
664: }
665: }
666: }
667: undef($navmap);
668: return (\@groupboards,\%boardshash);
669: }
670:
671: ###############################################
672:
1.1 raeburn 673: 1;
674: