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

1.1       raeburn     1: # The LearningOnline Network with CAPA
                      2: # accessor routines used to provide information about course groups 
                      3: #
1.27    ! raeburn     4: # $Id: longroup.pm,v 1.26 2010/09/26 01:57:21 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;
1.26      raeburn   294:             my $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
1.27    ! raeburn   295:             my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid,undef,$extra);
1.5       albertel  296: 	    if (my $tmp = &Apache::lonnet::error(%roleshash)) {
1.1       raeburn   297:                 &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
                    298:                                          ' for '.$uname.':'.$udom);
                    299:             } else {
                    300:                 my $group_privs = '';
                    301:                 foreach my $group (@changegroups) {
                    302:                     if ($chgtype eq 'add') {
                    303:                         if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
                    304:                             $group_privs =
                    305:                                   join(':',@{$settings{$group}{'defpriv'}});
                    306:                         }
                    307:                     }
                    308:                     my $key = $cid.'/'.$group.'_gr';
                    309:                     if (defined($roleshash{$key})) {
                    310:                         if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
                    311:                             my $grpstart = $3;
                    312:                             my $grpend = $2;
                    313:                             $currpriv{$group} = $1;
                    314:                             if ($chgtype eq 'drop') {
                    315:                                 if ($grpstart == -1) { next; } # deleted
                    316:                                 if ($grpend == 0 || $grpend > $now) {
1.2       albertel  317:                                     if (!defined($dropgroup{$group})) {
1.1       raeburn   318:                                         $dropstart{$group} = $grpstart;
                    319:                                         if ($grpstart > $now) {
                    320:                                             $dropstart{$group} = $now;
                    321:                                         }
                    322:                                         $dropgroup{$group} = $now.':'.
                    323:                                                             $dropstart{$group}.
                    324:                                                          ':'.$currpriv{$group};
                    325:                                     }
                    326:                                 }
                    327:                             } elsif ($chgtype eq 'add') {
                    328:                                 if (($grpstart == -1) || ($grpend > 0 &&
                    329:                                      ($grpend < $settings{$group}{'enddate'} ||
                    330:                                       $settings{$group}{'enddate'} == 0)) ||
                    331:                                      ($grpstart > $settings{$group}{'startdate'})) {
1.2       albertel  332:                                     if (!defined($addgroup{$group})) {
1.1       raeburn   333:                                         $addgroup{$group} =
                    334:                                             $settings{$group}{'enddate'}.':'.
                    335:                                             $settings{$group}{'startdate'}.':'.
                    336:                                             $group_privs;
                    337:                                     }
                    338:                                 }
                    339:                             }
                    340:                         }
                    341:                     } elsif ($chgtype eq 'add') {
                    342:                         $addgroup{$group} = $settings{$group}{'enddate'}.':'.
                    343:                                             $settings{$group}{'startdate'}.':'.
                    344:                                             $group_privs;
                    345:                     }
                    346:                 }
                    347:                 if ($chgtype eq 'add') {
                    348:                     foreach my $add (keys(%addgroup)) {
                    349:                         if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
                    350:                                                   $add,$uname.':'.$udom,
                    351:                                                   $settings{$add}{'enddate'},
                    352:                                                   $settings{$add}{'startdate'},
1.16      raeburn   353:                                                   $group_privs,$selfenroll,$context) eq 'ok') {
1.1       raeburn   354:                             my %usersettings;
                    355:                             $usersettings{$add.':'.$uname.':'.$udom} =
                    356:                                                                $addgroup{$add};
                    357:                             my $roster_result =
                    358:                                &Apache::lonnet::modify_coursegroup_membership(
                    359:                                                    $cdom,$cnum,\%usersettings);
                    360:                         }
                    361:                     }
                    362:                 } elsif ($chgtype eq 'drop') {
                    363:                     foreach my $drop (keys(%dropgroup)) {
                    364:                         my $nodrop = 0;
                    365:                         if ($settings{$drop}{'autoadd'} eq 'on') {
                    366:                             foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
                    367:                                 if ($nodrop) {
                    368:                                     last;
                    369:                                 } else {
                    370:                                     my @autosec = ();
                    371:                                     if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
                    372:                                         @autosec = @{$settings{$drop}{'autosec'}{$urole}};
                    373:                                     }
                    374:                                     foreach my $usec (@autosec) {
                    375:                                         if ($usec eq 'all') {
                    376:                                             foreach my $ukey (keys(%roleshash)) {
                    377:                                                 if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
1.2       albertel  378:                                                     if ($sec ne $1) {
1.1       raeburn   379:                                                         if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
                    380:                                                             my $roleend = $1;
                    381:                                                             if ((!$roleend) ||
                    382:                                                                 ($roleend > $now)) {
                    383:                                                                 $nodrop = 1;
                    384:                                                                 last;
                    385:                                                             }
                    386:                                                         }
                    387:                                                     }
                    388:                                                 }
                    389:                                             }
                    390:                                         } else {
                    391:                                             my $ukey = $cid.'/'.$usec.'_'.$urole;
                    392:                                             if ($usec eq 'none') {
                    393:                                                 if ($sec eq '') {
                    394:                                                     next;
                    395:                                                 }
                    396:                                             } else {
                    397:                                                 if ($usec eq $sec) {
                    398:                                                     next;
                    399:                                                 }
                    400:                                             }
                    401:                                             if (exists($roleshash{$ukey})) {
                    402:                                                 if ($roleshash{$ukey} =~
                    403:                                                        /_?(\d*)_?([\-\d]*)$/) {
                    404:                                                     my $roleend = $1;
                    405:                                                     if ((!$roleend) ||
                    406:                                                         ($roleend > $now)) {
                    407:                                                         $nodrop = 1;
                    408:                                                         last;
                    409:                                                     }
                    410:                                                 }
                    411:                                             }
                    412:                                         }
                    413:                                     }
                    414:                                 }
                    415:                             }
                    416:                         }
                    417:                         if (!$nodrop) {
                    418:                             if (&Apache::lonnet::modify_group_roles($cdom,
                    419:                                                          $cnum,$drop,
                    420:                                                          $uname.':'.$udom,$now,
                    421:                                                          $dropstart{$drop},
1.16      raeburn   422:                                                          $currpriv{$drop},
                    423:                                                          $selfenroll,$context) 
1.1       raeburn   424:                                                                      eq 'ok') {
                    425:                                 my %usersettings;
                    426:                                 $usersettings{$drop.':'.$uname.':'.$udom} =
                    427:                                                              $dropgroup{$drop};
                    428:                                 my $roster_result =
                    429:                                 &Apache::lonnet::modify_coursegroup_membership(
                    430:                                                    $cdom,$cnum,\%usersettings);
                    431:                             }
                    432:                         }
                    433:                     }
                    434:                 }
                    435:             }
                    436:         }
                    437:     }
                    438:     return;
                    439: }
                    440: 
                    441: ###############################################
                    442: 
1.8       raeburn   443: sub get_fixed_privs {
                    444:     my $fixedprivs = {
1.20      schafran  445:                       email          => {sgm => 1},
1.19      schafran  446:                       discussion     => {vgb => 1},
                    447:                       chat           => {pgc => 1},
                    448:                       files          => {rgf => 1},
                    449:                       roster         => {vgm => 1},
                    450:                       homepage       => {vgh => 1},
1.8       raeburn   451:                      };
                    452:     return $fixedprivs;
                    453: }
                    454: 
                    455: ###############################################
                    456: 
                    457: sub get_tool_privs {
                    458:     my ($gpterm) = @_;
                    459:     my $toolprivs = {
1.20      schafran  460:         email    => {
1.18      schafran  461:             sgm => 'Send '.$gpterm.' message',
                    462:             sgb => 'Broadcast message',
1.8       raeburn   463:         },
                    464:         discussion => {
                    465:             cgb => 'Create boards',
                    466:             pgd => 'Post',
1.10      raeburn   467:             egp => 'Edit own posts',
                    468:             dgp => 'Hide/Delete any post',
1.8       raeburn   469:             vgb => 'View boards',
                    470:         },
                    471:         chat       => {
1.22      hauer     472:             pgc => 'Chat Room',
1.8       raeburn   473:         },
                    474:         files      => {
                    475:             rgf => 'Retrieve',
                    476:             ugf => 'Upload',
                    477:             mgf => 'Modify',
                    478:             dgf => 'Delete',
                    479:             agf => 'Control Access',
                    480:         },
                    481:         roster     => {
1.10      raeburn   482:             vgm => 'Basic Display',
                    483:             vmd => 'Detailed Display',
1.8       raeburn   484:         },
                    485:         homepage   => {
                    486:             vgh => 'View page',
                    487:             mgh => 'Modify page',
                    488:         },
                    489:     };
                    490:     return $toolprivs;
                    491: }
                    492: 
                    493: ###############################################
                    494: 
                    495: 
                    496: sub group_memberlist {
                    497:     my ($cdom,$cnum,$groupname,$fixedprivs,$available) = @_;
                    498:     my %membership = &Apache::lonnet::get_group_membership($cdom,$cnum,
                    499:                                                            $groupname);
                    500:     my %current = ();
                    501:     my $hastools = 0;
                    502:     my $addtools = 0;
1.9       raeburn   503:     my %member_nums = (
                    504:                         'previous' => 0,
                    505:                         'future' => 0,
                    506:                         'active' => 0,
                    507:                       );
1.8       raeburn   508:     my $now = time;
                    509:     if (keys(%membership) > 0) {
                    510:         my %allnames = ();
                    511:         foreach my $key (sort(keys(%membership))) {
                    512:             if ($key =~ /^\Q$groupname\E:([^:]+):([^:]+)$/) {
                    513:                 my $uname = $1;
                    514:                 my $udom = $2;
                    515:                 my $user = $uname.':'.$udom;
                    516:                 my($end,$start,@userprivs) = split(/:/,$membership{$key});
                    517:                 unless ($start == -1) {
                    518:                     $allnames{$udom}{$uname} = 1;
                    519:                     $current{$user} = {
                    520:                         uname     => $uname,
                    521:                         udom      => $udom,
                    522:                         start     => &Apache::lonlocal::locallocaltime($start),
                    523:                         currtools => [],
                    524:                         newtools  => [],
                    525:                         privs     => \@userprivs,
                    526:                     };
                    527: 
                    528:                     if ($end == 0) {
                    529:                         $current{$user}{end} =  'No end date';
                    530:                     } else {
                    531:                         $current{$user}{end} =
                    532:                                      &Apache::lonlocal::locallocaltime($end);
                    533:                     }
                    534:                     my $now = time;
                    535:                     if (($end > 0) && ($end < $now)) {
                    536:                         $current{$user}{changestate} = 'reenable';
                    537:                         $current{$user}{'status'} = 'previous';
1.9       raeburn   538:                         $member_nums{'previous'} ++;
1.8       raeburn   539:                     } elsif (($start > $now)) {
                    540:                         $current{$user}{changestate} = 'activate';
                    541:                         $current{$user}{'status'} = 'future';
1.9       raeburn   542:                         $member_nums{'future'} ++;
1.8       raeburn   543:                     } else {
                    544:                         $current{$user}{changestate} = 'expire';
                    545:                         $current{$user}{'status'} = 'active';
1.9       raeburn   546:                         $member_nums{'active'} ++;
1.8       raeburn   547:                     }
1.10      raeburn   548:                     if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
1.8       raeburn   549:                         foreach my $tool (sort(keys(%{$fixedprivs}))) {
                    550:                             foreach my $priv (keys(%{$$fixedprivs{$tool}})) {
                    551:                                 if (grep/^$priv$/,@userprivs) {
                    552:                                     push(@{$current{$user}{currtools}},$tool);
                    553:                                     last;
                    554:                                 }
                    555:                             }
                    556:                         }
                    557:                         $hastools = 1;
                    558:                     }
1.10      raeburn   559:                     if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
1.8       raeburn   560:                         if (@{$current{$user}{currtools}} > 0) {
                    561:                             if ("@{$available}" ne "@{$current{$user}{currtools}}") {
                    562:                                 foreach my $tool (@{$available}) {
                    563:                                     unless (grep/^$tool$/,@{$current{$user}{currtools}}) {
                    564:                                         push(@{$current{$user}{newtools}},$tool);                                    }
                    565:                                 }
                    566:                             }
                    567:                         } else {
                    568:                             @{$current{$user}{newtools}} = @{$available};
                    569: 
                    570:                         }
                    571:                         if (@{$current{$user}{newtools}} > 0) {
                    572:                             $addtools = 1;
                    573:                         }
                    574:                     }
                    575:                 }
                    576:             }
                    577:         }
                    578:         if (keys(%current) > 0) {
                    579:             my %idhash;
                    580:             foreach my $udom (keys(%allnames)) {
                    581:                 %{$idhash{$udom}} = &Apache::lonnet::idrget($udom,
                    582:                                                 keys(%{$allnames{$udom}}));
                    583:                 foreach my $uname (keys(%{$idhash{$udom}})) {
                    584:                     $current{$uname.':'.$udom}{'id'} = $idhash{$udom}{$uname};
                    585:                 }
                    586:                 foreach my $uname (keys(%{$allnames{$udom}})) {
                    587:                     $current{$uname.':'.$udom}{'fullname'} =
                    588:                                 &Apache::loncommon::plainname($uname,$udom,
                    589:                                                                   'lastname');
                    590:                 }
                    591:             }
                    592:         }
                    593:     }
1.10      raeburn   594:     return (\%current,\%member_nums,$hastools,$addtools);
1.8       raeburn   595: }
                    596: 
                    597: ###############################################
                    598: 
1.6       raeburn   599: sub sum_quotas {
                    600:     my ($courseid) = @_;
                    601:     my $totalquotas = 0;
                    602:     my ($cdom,$cnum);
                    603:     if (!defined($courseid)) {
                    604:         if (defined($env{'request.course.id'})) {
                    605:             $courseid = $env{'request.course.id'};
                    606:             $cdom = $env{'course.'.$courseid.'.domain'};
                    607:             $cnum = $env{'course.'.$courseid.'.num'};
                    608:         } else {
                    609:             return '';
                    610:         }
                    611:     } else {
                    612:         ($cdom,$cnum) = split(/_/,$courseid);
                    613:     }
                    614:     if ($cdom && $cnum) {
                    615:         my %curr_groups = &coursegroups($cdom,$cnum);
                    616:         if (%curr_groups) {
                    617:             foreach my $group (keys(%curr_groups)) {
                    618:                 my %settings=&get_group_settings($curr_groups{$group});
                    619:                 my $quota = $settings{'quota'};
                    620:                 if ($quota eq '') {
                    621:                     $quota = 0;
                    622:                 }
                    623:                 $totalquotas += $quota; 
                    624:             }
                    625:         } else {
                    626:             return 0;
                    627:         }
                    628:     } else {
                    629:         return '';
                    630:     }
                    631:     return $totalquotas;
                    632: }
                    633: 
                    634: ###############################################
                    635: 
1.7       raeburn   636: sub get_bbfolder_url {
                    637:     my ($cdom,$cnum,$group) = @_;
                    638:     my %curr_groups = &coursegroups($cdom,$cnum,$group);
                    639:     my $grpbbmap;
                    640:     if (%curr_groups) {
                    641:         my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
1.9       raeburn   642:         $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
1.7       raeburn   643:     }
                    644:     return $grpbbmap;
                    645: }
                    646: 
                    647: ###############################################
                    648: 
                    649: sub get_group_bbinfo {
1.10      raeburn   650:     my ($cdom,$cnum,$group,$boardurl) = @_;
1.17      raeburn   651:     my @groupboards = ();
                    652:     my %boardshash = ();
1.7       raeburn   653:     my $navmap = Apache::lonnavmaps::navmap->new();
1.17      raeburn   654:     if (defined($navmap)) {
                    655:         my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
                    656:         if ($grpbbmap) {
                    657:             my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
                    658:             if ($bbfolderres) {
                    659:                 my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
                    660:                 foreach my $res (@boards) {
                    661:                     my $url = $res->src();
                    662:                     if ($url =~ m|^(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
                    663:                         if ($boardurl) {
                    664:                             if ($boardurl =~ /^\Q$1\E/) {
                    665:                                 push(@groupboards,$res->symb());
                    666:                                 $boardshash{$res->symb()} = {
                    667:                                                         title => $res->title(),
                    668:                                                         url   => $res->src(),
                    669:                                                             };
                    670:                                 last;
                    671:                             }
                    672:                         } else {
1.10      raeburn   673:                             push(@groupboards,$res->symb());
                    674:                             $boardshash{$res->symb()} = {
1.17      raeburn   675:                                                       title => $res->title(),
                    676:                                                       url   => $res->src(),
1.10      raeburn   677:                                                         };
                    678:                         }
                    679:                     }
1.7       raeburn   680:                 }
                    681:             }
                    682:         }
1.17      raeburn   683:         undef($navmap);
                    684:     } else {
                    685:         &Apache::lonnet::logthis('Retrieval of group boards failed - could not create navmap object for group: '.$group.' in course: '.$cdom.':'.$cnum);
1.7       raeburn   686:     }
                    687:     return (\@groupboards,\%boardshash);
                    688: }
                    689: 
                    690: ###############################################
                    691: 
1.24      raeburn   692: sub get_group_link {
                    693:     my ($cdom,$cnum,$group,$navmap) = @_;
                    694:     if (ref($navmap)) {
                    695:         my $symb = 'uploaded/'.$cdom.'/'.$cnum.'/group_folder_'.$group.'.sequence___1___adm/'.$cdom.'/'.$cnum.'/'.$group.'/smppg';
                    696:         my $res = $navmap->getBySymb($symb);
1.25      raeburn   697:         my $link;
                    698:         if (ref($res)) {
                    699:             $link = $res->link();
                    700:             $link .= (($link=~/\?/)?'&amp;':'?').'symb='.$res->shown_symb();
                    701:         } else {
                    702:             $link = '/adm/'.$cdom.'/'.$cnum.'/'.$group.'/smppg';
                    703:         }
                    704:         return $link; 
1.24      raeburn   705:     }
                    706:     return;
                    707: }
                    708: 
                    709: ###############################################
                    710: 
1.1       raeburn   711: 1;
                    712: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.