Annotation of loncom/interface/longroup.pm, revision 1.31
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # accessor routines used to provide information about course groups
3: #
1.31 ! musolffc 4: # $Id: longroup.pm,v 1.30 2016/02/26 21:44:39 raeburn Exp $
1.21 bisitz 5: #
1.1 raeburn 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: #
1.4 albertel 28:
1.1 raeburn 29: package Apache::longroup;
1.4 albertel 30:
1.1 raeburn 31: use strict;
32: use Apache::lonnet;
1.19 schafran 33: use Apache::lonlocal;
1.23 raeburn 34: use LONCAPA;
1.1 raeburn 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
1.13 raeburn 47: 4. Optional namespace
1.1 raeburn 48:
49: Course domain and number will be taken from user's
50: environment if not supplied. Optional group name will
1.13 raeburn 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).
1.4 albertel 55:
1.1 raeburn 56: Output
1.13 raeburn 57: Returns hash of groups in a course (subject to the
1.1 raeburn 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.
1.15 albertel 65:
1.1 raeburn 66: =cut
67:
68: ###############################################
69:
70: sub coursegroups {
1.13 raeburn 71: my ($cdom,$cnum,$group,$namespace) = @_;
1.1 raeburn 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: }
1.13 raeburn 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);
1.1 raeburn 88: }
1.14 raeburn 89: if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
90: delete($groups{'group_allfolders'."\0".'locked_folder'});
91: }
1.13 raeburn 92: return %groups;
1.1 raeburn 93: }
94:
95: ###############################################
96:
1.15 albertel 97: =pod
98:
1.1 raeburn 99: =item get_group_settings
1.4 albertel 100:
1.1 raeburn 101: Uses TokeParser to extract group information from the
102: XML used to describe course groups.
1.4 albertel 103:
1.1 raeburn 104: Input:
105: Scalar containing XML - as retrieved from &coursegroups().
1.4 albertel 106:
1.1 raeburn 107: Output:
108: Hash containing group information as key=values for (a), and
109: hash of hashes for (b)
1.4 albertel 110:
1.1 raeburn 111: Keys (in two categories):
1.6 raeburn 112: (a) groupname, creator, creation, modified, startdate, enddate, quota.
1.1 raeburn 113: Corresponding values are name of the group, creator of the group
114: (username:domain), UNIX time for date group was created, and
1.6 raeburn 115: settings were last modified, file quota, and default start and end
116: access times for group members.
1.4 albertel 117:
1.1 raeburn 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.
1.4 albertel 123:
1.1 raeburn 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
1.4 albertel 192:
1.1 raeburn 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()
1.4 albertel 198:
1.1 raeburn 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
1.16 raeburn 206: 7. Selfenroll
207: 8. Context
1.1 raeburn 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
1.29 raeburn 221: for auto-group population, unless user is already a group member.
1.1 raeburn 222: Uses default group privileges and default start and end group access
1.16 raeburn 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.
1.1 raeburn 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 {
1.16 raeburn 240: my ($udom,$uname,$url,$role,$origend,$origstart,$selfenroll,$context) = @_;
1.1 raeburn 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 %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;
1.28 raeburn 291: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
1.29 raeburn 292: if (keys(%roleshash) > 0) {
1.1 raeburn 293: my $group_privs = '';
294: foreach my $group (@changegroups) {
295: if ($chgtype eq 'add') {
296: if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
297: $group_privs =
298: join(':',@{$settings{$group}{'defpriv'}});
299: }
300: }
301: my $key = $cid.'/'.$group.'_gr';
302: if (defined($roleshash{$key})) {
303: if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
304: my $grpstart = $3;
305: my $grpend = $2;
306: $currpriv{$group} = $1;
307: if ($chgtype eq 'drop') {
308: if ($grpstart == -1) { next; } # deleted
309: if ($grpend == 0 || $grpend > $now) {
1.2 albertel 310: if (!defined($dropgroup{$group})) {
1.1 raeburn 311: $dropstart{$group} = $grpstart;
312: if ($grpstart > $now) {
313: $dropstart{$group} = $now;
314: }
315: $dropgroup{$group} = $now.':'.
316: $dropstart{$group}.
317: ':'.$currpriv{$group};
318: }
319: }
320: } elsif ($chgtype eq 'add') {
321: if (($grpstart == -1) || ($grpend > 0 &&
322: ($grpend < $settings{$group}{'enddate'} ||
323: $settings{$group}{'enddate'} == 0)) ||
324: ($grpstart > $settings{$group}{'startdate'})) {
1.2 albertel 325: if (!defined($addgroup{$group})) {
1.1 raeburn 326: $addgroup{$group} =
327: $settings{$group}{'enddate'}.':'.
328: $settings{$group}{'startdate'}.':'.
329: $group_privs;
330: }
331: }
332: }
333: }
334: } elsif ($chgtype eq 'add') {
335: $addgroup{$group} = $settings{$group}{'enddate'}.':'.
336: $settings{$group}{'startdate'}.':'.
337: $group_privs;
338: }
339: }
340: if ($chgtype eq 'add') {
341: foreach my $add (keys(%addgroup)) {
342: if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
343: $add,$uname.':'.$udom,
344: $settings{$add}{'enddate'},
345: $settings{$add}{'startdate'},
1.16 raeburn 346: $group_privs,$selfenroll,$context) eq 'ok') {
1.1 raeburn 347: my %usersettings;
348: $usersettings{$add.':'.$uname.':'.$udom} =
349: $addgroup{$add};
350: my $roster_result =
351: &Apache::lonnet::modify_coursegroup_membership(
352: $cdom,$cnum,\%usersettings);
353: }
354: }
355: } elsif ($chgtype eq 'drop') {
356: foreach my $drop (keys(%dropgroup)) {
357: my $nodrop = 0;
358: if ($settings{$drop}{'autoadd'} eq 'on') {
359: foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
360: if ($nodrop) {
361: last;
362: } else {
363: my @autosec = ();
364: if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
365: @autosec = @{$settings{$drop}{'autosec'}{$urole}};
366: }
367: foreach my $usec (@autosec) {
368: if ($usec eq 'all') {
369: foreach my $ukey (keys(%roleshash)) {
370: if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
1.2 albertel 371: if ($sec ne $1) {
1.1 raeburn 372: if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
373: my $roleend = $1;
374: if ((!$roleend) ||
375: ($roleend > $now)) {
376: $nodrop = 1;
377: last;
378: }
379: }
380: }
381: }
382: }
383: } else {
384: my $ukey = $cid.'/'.$usec.'_'.$urole;
385: if ($usec eq 'none') {
386: if ($sec eq '') {
387: next;
388: }
389: } else {
390: if ($usec eq $sec) {
391: next;
392: }
393: }
394: if (exists($roleshash{$ukey})) {
395: if ($roleshash{$ukey} =~
396: /_?(\d*)_?([\-\d]*)$/) {
397: my $roleend = $1;
398: if ((!$roleend) ||
399: ($roleend > $now)) {
400: $nodrop = 1;
401: last;
402: }
403: }
404: }
405: }
406: }
407: }
408: }
409: }
410: if (!$nodrop) {
411: if (&Apache::lonnet::modify_group_roles($cdom,
412: $cnum,$drop,
413: $uname.':'.$udom,$now,
414: $dropstart{$drop},
1.16 raeburn 415: $currpriv{$drop},
416: $selfenroll,$context)
1.1 raeburn 417: eq 'ok') {
418: my %usersettings;
419: $usersettings{$drop.':'.$uname.':'.$udom} =
420: $dropgroup{$drop};
421: my $roster_result =
422: &Apache::lonnet::modify_coursegroup_membership(
423: $cdom,$cnum,\%usersettings);
424: }
425: }
426: }
427: }
428: }
429: }
430: }
431: return;
432: }
433:
434: ###############################################
435:
1.8 raeburn 436: sub get_fixed_privs {
437: my $fixedprivs = {
1.20 schafran 438: email => {sgm => 1},
1.19 schafran 439: discussion => {vgb => 1},
440: chat => {pgc => 1},
441: files => {rgf => 1},
442: roster => {vgm => 1},
443: homepage => {vgh => 1},
1.8 raeburn 444: };
445: return $fixedprivs;
446: }
447:
448: ###############################################
449:
450: sub get_tool_privs {
451: my ($gpterm) = @_;
452: my $toolprivs = {
1.20 schafran 453: email => {
1.18 schafran 454: sgm => 'Send '.$gpterm.' message',
455: sgb => 'Broadcast message',
1.8 raeburn 456: },
457: discussion => {
458: cgb => 'Create boards',
459: pgd => 'Post',
1.10 raeburn 460: egp => 'Edit own posts',
461: dgp => 'Hide/Delete any post',
1.8 raeburn 462: vgb => 'View boards',
463: },
464: chat => {
1.22 hauer 465: pgc => 'Chat Room',
1.8 raeburn 466: },
467: files => {
468: rgf => 'Retrieve',
469: ugf => 'Upload',
470: mgf => 'Modify',
471: dgf => 'Delete',
472: agf => 'Control Access',
473: },
474: roster => {
1.10 raeburn 475: vgm => 'Basic Display',
476: vmd => 'Detailed Display',
1.8 raeburn 477: },
478: homepage => {
479: vgh => 'View page',
480: mgh => 'Modify page',
481: },
482: };
483: return $toolprivs;
484: }
485:
486: ###############################################
487:
488:
489: sub group_memberlist {
490: my ($cdom,$cnum,$groupname,$fixedprivs,$available) = @_;
491: my %membership = &Apache::lonnet::get_group_membership($cdom,$cnum,
492: $groupname);
493: my %current = ();
494: my $hastools = 0;
495: my $addtools = 0;
1.9 raeburn 496: my %member_nums = (
497: 'previous' => 0,
498: 'future' => 0,
499: 'active' => 0,
500: );
1.8 raeburn 501: my $now = time;
502: if (keys(%membership) > 0) {
503: my %allnames = ();
504: foreach my $key (sort(keys(%membership))) {
505: if ($key =~ /^\Q$groupname\E:([^:]+):([^:]+)$/) {
506: my $uname = $1;
507: my $udom = $2;
508: my $user = $uname.':'.$udom;
509: my($end,$start,@userprivs) = split(/:/,$membership{$key});
510: unless ($start == -1) {
511: $allnames{$udom}{$uname} = 1;
512: $current{$user} = {
513: uname => $uname,
514: udom => $udom,
515: start => &Apache::lonlocal::locallocaltime($start),
516: currtools => [],
517: newtools => [],
518: privs => \@userprivs,
519: };
520:
521: if ($end == 0) {
522: $current{$user}{end} = 'No end date';
523: } else {
524: $current{$user}{end} =
525: &Apache::lonlocal::locallocaltime($end);
526: }
527: my $now = time;
528: if (($end > 0) && ($end < $now)) {
529: $current{$user}{changestate} = 'reenable';
530: $current{$user}{'status'} = 'previous';
1.9 raeburn 531: $member_nums{'previous'} ++;
1.8 raeburn 532: } elsif (($start > $now)) {
533: $current{$user}{changestate} = 'activate';
534: $current{$user}{'status'} = 'future';
1.9 raeburn 535: $member_nums{'future'} ++;
1.8 raeburn 536: } else {
537: $current{$user}{changestate} = 'expire';
538: $current{$user}{'status'} = 'active';
1.9 raeburn 539: $member_nums{'active'} ++;
1.8 raeburn 540: }
1.10 raeburn 541: if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
1.8 raeburn 542: foreach my $tool (sort(keys(%{$fixedprivs}))) {
543: foreach my $priv (keys(%{$$fixedprivs{$tool}})) {
544: if (grep/^$priv$/,@userprivs) {
545: push(@{$current{$user}{currtools}},$tool);
546: last;
547: }
548: }
549: }
550: $hastools = 1;
551: }
1.10 raeburn 552: if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
1.8 raeburn 553: if (@{$current{$user}{currtools}} > 0) {
554: if ("@{$available}" ne "@{$current{$user}{currtools}}") {
555: foreach my $tool (@{$available}) {
556: unless (grep/^$tool$/,@{$current{$user}{currtools}}) {
557: push(@{$current{$user}{newtools}},$tool); }
558: }
559: }
560: } else {
561: @{$current{$user}{newtools}} = @{$available};
562:
563: }
564: if (@{$current{$user}{newtools}} > 0) {
565: $addtools = 1;
566: }
567: }
568: }
569: }
570: }
571: if (keys(%current) > 0) {
572: my %idhash;
573: foreach my $udom (keys(%allnames)) {
574: %{$idhash{$udom}} = &Apache::lonnet::idrget($udom,
575: keys(%{$allnames{$udom}}));
576: foreach my $uname (keys(%{$idhash{$udom}})) {
577: $current{$uname.':'.$udom}{'id'} = $idhash{$udom}{$uname};
578: }
579: foreach my $uname (keys(%{$allnames{$udom}})) {
580: $current{$uname.':'.$udom}{'fullname'} =
581: &Apache::loncommon::plainname($uname,$udom,
582: 'lastname');
583: }
584: }
585: }
586: }
1.10 raeburn 587: return (\%current,\%member_nums,$hastools,$addtools);
1.8 raeburn 588: }
589:
590: ###############################################
591:
1.6 raeburn 592: sub sum_quotas {
593: my ($courseid) = @_;
594: my $totalquotas = 0;
595: my ($cdom,$cnum);
596: if (!defined($courseid)) {
597: if (defined($env{'request.course.id'})) {
598: $courseid = $env{'request.course.id'};
599: $cdom = $env{'course.'.$courseid.'.domain'};
600: $cnum = $env{'course.'.$courseid.'.num'};
601: } else {
602: return '';
603: }
604: } else {
605: ($cdom,$cnum) = split(/_/,$courseid);
606: }
607: if ($cdom && $cnum) {
608: my %curr_groups = &coursegroups($cdom,$cnum);
609: if (%curr_groups) {
610: foreach my $group (keys(%curr_groups)) {
611: my %settings=&get_group_settings($curr_groups{$group});
612: my $quota = $settings{'quota'};
613: if ($quota eq '') {
614: $quota = 0;
615: }
616: $totalquotas += $quota;
617: }
618: } else {
619: return 0;
620: }
621: } else {
622: return '';
623: }
624: return $totalquotas;
625: }
626:
627: ###############################################
628:
1.7 raeburn 629: sub get_bbfolder_url {
630: my ($cdom,$cnum,$group) = @_;
631: my %curr_groups = &coursegroups($cdom,$cnum,$group);
632: my $grpbbmap;
633: if (%curr_groups) {
634: my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
1.9 raeburn 635: $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
1.7 raeburn 636: }
637: return $grpbbmap;
638: }
639:
640: ###############################################
641:
642: sub get_group_bbinfo {
1.10 raeburn 643: my ($cdom,$cnum,$group,$boardurl) = @_;
1.17 raeburn 644: my @groupboards = ();
645: my %boardshash = ();
1.7 raeburn 646: my $navmap = Apache::lonnavmaps::navmap->new();
1.17 raeburn 647: if (defined($navmap)) {
648: my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
649: if ($grpbbmap) {
650: my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
651: if ($bbfolderres) {
652: my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
653: foreach my $res (@boards) {
654: my $url = $res->src();
655: if ($url =~ m|^(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
656: if ($boardurl) {
657: if ($boardurl =~ /^\Q$1\E/) {
658: push(@groupboards,$res->symb());
659: $boardshash{$res->symb()} = {
660: title => $res->title(),
661: url => $res->src(),
662: };
663: last;
664: }
665: } else {
1.10 raeburn 666: push(@groupboards,$res->symb());
667: $boardshash{$res->symb()} = {
1.17 raeburn 668: title => $res->title(),
669: url => $res->src(),
1.10 raeburn 670: };
671: }
672: }
1.7 raeburn 673: }
674: }
675: }
1.17 raeburn 676: undef($navmap);
677: } else {
678: &Apache::lonnet::logthis('Retrieval of group boards failed - could not create navmap object for group: '.$group.' in course: '.$cdom.':'.$cnum);
1.7 raeburn 679: }
680: return (\@groupboards,\%boardshash);
681: }
682:
683: ###############################################
684:
1.24 raeburn 685: sub get_group_link {
1.30 raeburn 686: my ($cdom,$cnum,$group,$navmap,$view_permission,$refarg) = @_;
1.24 raeburn 687: if (ref($navmap)) {
1.30 raeburn 688: my $map = "uploaded/$cdom/$cnum/group_folder_"."$group.sequence";
689: my $mapres = $navmap->getResourceByUrl("/$map");
690: my $hidden;
691: if (ref($mapres)) {
1.31 ! musolffc 692: if ((!$view_permission) && ($mapres->randomout())) {
1.30 raeburn 693: $hidden = 1;
694: }
695: }
696: my $url = "adm/$cdom/$cnum/$group/smppg";
697: my $idx = '1';
698: my $symb = $map.'___'.$idx.'___'.$url;
1.24 raeburn 699: my $res = $navmap->getBySymb($symb);
1.30 raeburn 700: $url = "/$url";
701: $map = "/$map";
1.25 raeburn 702: my $link;
703: if (ref($res)) {
1.30 raeburn 704: if ((!$view_permission) && ($res->randomout())) {
705: $hidden = 1;
706: } else {
707: $hidden = 0;
708: if ($refarg) {
709: $link = $url.'?'.$refarg;
710: } else {
711: $link = $res->link();
712: $link .= (($link=~/\?/)?'&':'?').'symb='.$res->shown_symb();
713: }
714: }
715: } elsif (&Apache::lonnet::is_on_map($url)) {
716: unless ($hidden) {
717: $link = $url;
718: if ($refarg) {
719: $link = $url.'?'.$refarg;
720: }
721: }
722: }
723: if (wantarray) {
724: return ($link,$hidden);
1.25 raeburn 725: } else {
1.30 raeburn 726: return $link;
1.25 raeburn 727: }
1.24 raeburn 728: }
729: return;
730: }
731:
732: ###############################################
733:
1.30 raeburn 734: sub display_group_links {
735: my ($r,$target,$group,$context,$refarg,$numtoolsref,$hidehdr,%groupinfo) = @_;
736: my @available = ();
737: my %menu = ();
738: %{$menu{'email'}} = (
739: text => 'Group Message',
740: href => '/adm/email?compose=group&group='.$group.
741: $refarg,
742: );
743: %{$menu{'discussion'}} = (
744: text => 'Discussion Boards',
745: href => '/adm/groupboards?group='.$group.$refarg,
746: );
747: %{$menu{'chat'}} = (
748: text => 'Group Chat Room',
749: href => "javascript:group_chat('$group')",
750: );
751: %{$menu{'files'}} = (
752: text => 'Group Portfolio',
753: href => '/adm/coursegrp_portfolio?group='.$group.
754: $refarg,
755: );
756: %{$menu{'roster'}} = (
757: text => 'Membership Roster',
758: href => '/adm/grouproster?group='.$group.$refarg,
759: );
760: foreach my $tool (sort(keys(%menu))) {
761: if ($groupinfo{functions}{$tool} eq 'on') {
762: push(@available,$tool);
763: }
764: }
765: my $output = '';
766: if (ref($numtoolsref) eq 'SCALAR') {
767: $$numtoolsref = scalar(@available);
768: }
769: if (@available > 0) {
770: if ($target eq 'tex') {
771: $output = '<table cellspacing="4" cellpadding="4">';
772: } else {
773: $output = &Apache::loncommon::start_data_table();
774: }
775: foreach my $tool (@available) {
776: if ($target eq 'tex') {
777: $output .= '<tr><td>'.&mt($menu{$tool}{text}).'</td></tr>';
778: } else {
779: $output .= &Apache::loncommon::start_data_table_row()
780: .'<td><a href="'.$menu{$tool}{href}.'">'
781: .&mt($menu{$tool}{text}).'</a></td>'
782: .&Apache::loncommon::end_data_table_row();
783: }
784: }
785: if ($target eq 'tex') {
786: $output .= '</table>';
787: } else {
788: $output .= &Apache::loncommon::end_data_table();
789: }
790: if ($target eq 'tex') {
791: $output = &Apache::lonxml::xmlparse($r,'tex',&mt('Available functions').'<br /><br />'.$output);
792: } else {
793: unless ($hidehdr) {
794: $output = '<h3>'.&mt('Available Group Tools').'</h3>'.$output;
795: }
796: }
797: } else {
798: if ($context eq 'edit') {
799: $output = &mt('No group functionality.');
800: } else {
801: $output = &mt('No group functionality (e.g., e-mail, discussion, chat room or file upload) is currently available to you in this group: [_1].',
802: '<b>'.&unescape($groupinfo{'description'}).'</b>');
803: }
804: if ($target eq 'tex') {
805: $output = &Apache::lonxml::xmlparse($r,'tex',$output);
806: }
807: }
808: return $output;
809: }
810:
1.1 raeburn 811: 1;
812:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>