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