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