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