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