Annotation of loncom/interface/longroup.pm, revision 1.25

1.1       raeburn     1: # The LearningOnline Network with CAPA
                      2: # accessor routines used to provide information about course groups 
                      3: #
1.25    ! raeburn     4: # $Id: longroup.pm,v 1.24 2010/02/23 14:18:12 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
                    221: for auto-group population, unless use is already a group member.
                    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 $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);
1.5       albertel  295: 	    if (my $tmp = &Apache::lonnet::error(%roleshash)) {
1.1       raeburn   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) {
1.2       albertel  316:                                     if (!defined($dropgroup{$group})) {
1.1       raeburn   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'})) {
1.2       albertel  331:                                     if (!defined($addgroup{$group})) {
1.1       raeburn   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'},
1.16      raeburn   352:                                                   $group_privs,$selfenroll,$context) eq 'ok') {
1.1       raeburn   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)$/) {
1.2       albertel  377:                                                     if ($sec ne $1) {
1.1       raeburn   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},
1.16      raeburn   421:                                                          $currpriv{$drop},
                    422:                                                          $selfenroll,$context) 
1.1       raeburn   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: 
1.8       raeburn   442: sub get_fixed_privs {
                    443:     my $fixedprivs = {
1.20      schafran  444:                       email          => {sgm => 1},
1.19      schafran  445:                       discussion     => {vgb => 1},
                    446:                       chat           => {pgc => 1},
                    447:                       files          => {rgf => 1},
                    448:                       roster         => {vgm => 1},
                    449:                       homepage       => {vgh => 1},
1.8       raeburn   450:                      };
                    451:     return $fixedprivs;
                    452: }
                    453: 
                    454: ###############################################
                    455: 
                    456: sub get_tool_privs {
                    457:     my ($gpterm) = @_;
                    458:     my $toolprivs = {
1.20      schafran  459:         email    => {
1.18      schafran  460:             sgm => 'Send '.$gpterm.' message',
                    461:             sgb => 'Broadcast message',
1.8       raeburn   462:         },
                    463:         discussion => {
                    464:             cgb => 'Create boards',
                    465:             pgd => 'Post',
1.10      raeburn   466:             egp => 'Edit own posts',
                    467:             dgp => 'Hide/Delete any post',
1.8       raeburn   468:             vgb => 'View boards',
                    469:         },
                    470:         chat       => {
1.22      hauer     471:             pgc => 'Chat Room',
1.8       raeburn   472:         },
                    473:         files      => {
                    474:             rgf => 'Retrieve',
                    475:             ugf => 'Upload',
                    476:             mgf => 'Modify',
                    477:             dgf => 'Delete',
                    478:             agf => 'Control Access',
                    479:         },
                    480:         roster     => {
1.10      raeburn   481:             vgm => 'Basic Display',
                    482:             vmd => 'Detailed Display',
1.8       raeburn   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;
1.9       raeburn   502:     my %member_nums = (
                    503:                         'previous' => 0,
                    504:                         'future' => 0,
                    505:                         'active' => 0,
                    506:                       );
1.8       raeburn   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';
1.9       raeburn   537:                         $member_nums{'previous'} ++;
1.8       raeburn   538:                     } elsif (($start > $now)) {
                    539:                         $current{$user}{changestate} = 'activate';
                    540:                         $current{$user}{'status'} = 'future';
1.9       raeburn   541:                         $member_nums{'future'} ++;
1.8       raeburn   542:                     } else {
                    543:                         $current{$user}{changestate} = 'expire';
                    544:                         $current{$user}{'status'} = 'active';
1.9       raeburn   545:                         $member_nums{'active'} ++;
1.8       raeburn   546:                     }
1.10      raeburn   547:                     if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
1.8       raeburn   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:                     }
1.10      raeburn   558:                     if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
1.8       raeburn   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:     }
1.10      raeburn   593:     return (\%current,\%member_nums,$hastools,$addtools);
1.8       raeburn   594: }
                    595: 
                    596: ###############################################
                    597: 
1.6       raeburn   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: 
1.7       raeburn   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.'/';
1.9       raeburn   641:         $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
1.7       raeburn   642:     }
                    643:     return $grpbbmap;
                    644: }
                    645: 
                    646: ###############################################
                    647: 
                    648: sub get_group_bbinfo {
1.10      raeburn   649:     my ($cdom,$cnum,$group,$boardurl) = @_;
1.17      raeburn   650:     my @groupboards = ();
                    651:     my %boardshash = ();
1.7       raeburn   652:     my $navmap = Apache::lonnavmaps::navmap->new();
1.17      raeburn   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 {
1.10      raeburn   672:                             push(@groupboards,$res->symb());
                    673:                             $boardshash{$res->symb()} = {
1.17      raeburn   674:                                                       title => $res->title(),
                    675:                                                       url   => $res->src(),
1.10      raeburn   676:                                                         };
                    677:                         }
                    678:                     }
1.7       raeburn   679:                 }
                    680:             }
                    681:         }
1.17      raeburn   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);
1.7       raeburn   685:     }
                    686:     return (\@groupboards,\%boardshash);
                    687: }
                    688: 
                    689: ###############################################
                    690: 
1.24      raeburn   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);
1.25    ! raeburn   696:         my $link;
        !           697:         if (ref($res)) {
        !           698:             $link = $res->link();
        !           699:             $link .= (($link=~/\?/)?'&amp;':'?').'symb='.$res->shown_symb();
        !           700:         } else {
        !           701:             $link = '/adm/'.$cdom.'/'.$cnum.'/'.$group.'/smppg';
        !           702:         }
        !           703:         return $link; 
1.24      raeburn   704:     }
                    705:     return;
                    706: }
                    707: 
                    708: ###############################################
                    709: 
1.1       raeburn   710: 1;
                    711: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>