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