File:  [LON-CAPA] / loncom / interface / longroup.pm
Revision 1.27: download - view: text, annotated - select for diffs
Sat Nov 13 04:45:17 2010 UTC (13 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_1, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse
- Typo in args passed to lonnet::dump() (longroup.pm rev 1.26).

    1: # The LearningOnline Network with CAPA
    2: # accessor routines used to provide information about course groups 
    3: #
    4: # $Id: longroup.pm,v 1.27 2010/11/13 04:45:17 raeburn Exp $
    5: #
    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: #
   28: 
   29: package Apache::longroup;
   30: 
   31: use strict;
   32: use Apache::lonnet;
   33: use Apache::lonlocal;
   34: use LONCAPA;
   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
   47: 4. Optional namespace
   48: 
   49: Course domain and number will be taken from user's
   50: environment if not supplied. Optional group name will 
   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). 
   55: 
   56: Output
   57: Returns hash of groups in a course (subject to the
   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.
   65: 
   66: =cut
   67: 
   68: ###############################################
   69: 
   70: sub coursegroups {
   71:     my ($cdom,$cnum,$group,$namespace) = @_;
   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:     }
   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);
   88:     }
   89:     if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
   90:         delete($groups{'group_allfolders'."\0".'locked_folder'}); 
   91:     }
   92:     return %groups;
   93: }
   94: 
   95: ###############################################
   96: 
   97: =pod 
   98: 
   99: =item get_group_settings
  100: 
  101: Uses TokeParser to extract group information from the
  102: XML used to describe course groups.
  103: 
  104: Input:
  105: Scalar containing XML  - as retrieved from &coursegroups().
  106: 
  107: Output:
  108: Hash containing group information as key=values for (a), and
  109: hash of hashes for (b)
  110: 
  111: Keys (in two categories):
  112: (a) groupname, creator, creation, modified, startdate, enddate, quota.
  113: Corresponding values are name of the group, creator of the group
  114: (username:domain), UNIX time for date group was created, and
  115: settings were last modified, file quota, and default start and end 
  116: access times for group members.
  117: 
  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.
  123: 
  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
  192: 
  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()     
  198: 
  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
  206: 7. Selfenroll
  207: 8. Context
  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
  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.     
  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 {
  240:     my ($udom,$uname,$url,$role,$origend,$origstart,$selfenroll,$context) = @_;
  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 $extra = &Apache::lonnet::freeze_escape({'skipcheck' => 1});
  295:             my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid,undef,$extra);
  296: 	    if (my $tmp = &Apache::lonnet::error(%roleshash)) {
  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) {
  317:                                     if (!defined($dropgroup{$group})) {
  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'})) {
  332:                                     if (!defined($addgroup{$group})) {
  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'},
  353:                                                   $group_privs,$selfenroll,$context) eq 'ok') {
  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)$/) {
  378:                                                     if ($sec ne $1) {
  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},
  422:                                                          $currpriv{$drop},
  423:                                                          $selfenroll,$context) 
  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: 
  443: sub get_fixed_privs {
  444:     my $fixedprivs = {
  445:                       email          => {sgm => 1},
  446:                       discussion     => {vgb => 1},
  447:                       chat           => {pgc => 1},
  448:                       files          => {rgf => 1},
  449:                       roster         => {vgm => 1},
  450:                       homepage       => {vgh => 1},
  451:                      };
  452:     return $fixedprivs;
  453: }
  454: 
  455: ###############################################
  456: 
  457: sub get_tool_privs {
  458:     my ($gpterm) = @_;
  459:     my $toolprivs = {
  460:         email    => {
  461:             sgm => 'Send '.$gpterm.' message',
  462:             sgb => 'Broadcast message',
  463:         },
  464:         discussion => {
  465:             cgb => 'Create boards',
  466:             pgd => 'Post',
  467:             egp => 'Edit own posts',
  468:             dgp => 'Hide/Delete any post',
  469:             vgb => 'View boards',
  470:         },
  471:         chat       => {
  472:             pgc => 'Chat Room',
  473:         },
  474:         files      => {
  475:             rgf => 'Retrieve',
  476:             ugf => 'Upload',
  477:             mgf => 'Modify',
  478:             dgf => 'Delete',
  479:             agf => 'Control Access',
  480:         },
  481:         roster     => {
  482:             vgm => 'Basic Display',
  483:             vmd => 'Detailed Display',
  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;
  503:     my %member_nums = (
  504:                         'previous' => 0,
  505:                         'future' => 0,
  506:                         'active' => 0,
  507:                       );
  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';
  538:                         $member_nums{'previous'} ++;
  539:                     } elsif (($start > $now)) {
  540:                         $current{$user}{changestate} = 'activate';
  541:                         $current{$user}{'status'} = 'future';
  542:                         $member_nums{'future'} ++;
  543:                     } else {
  544:                         $current{$user}{changestate} = 'expire';
  545:                         $current{$user}{'status'} = 'active';
  546:                         $member_nums{'active'} ++;
  547:                     }
  548:                     if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
  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:                     }
  559:                     if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
  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:     }
  594:     return (\%current,\%member_nums,$hastools,$addtools);
  595: }
  596: 
  597: ###############################################
  598: 
  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: 
  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.'/';
  642:         $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
  643:     }
  644:     return $grpbbmap;
  645: }
  646: 
  647: ###############################################
  648: 
  649: sub get_group_bbinfo {
  650:     my ($cdom,$cnum,$group,$boardurl) = @_;
  651:     my @groupboards = ();
  652:     my %boardshash = ();
  653:     my $navmap = Apache::lonnavmaps::navmap->new();
  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 {
  673:                             push(@groupboards,$res->symb());
  674:                             $boardshash{$res->symb()} = {
  675:                                                       title => $res->title(),
  676:                                                       url   => $res->src(),
  677:                                                         };
  678:                         }
  679:                     }
  680:                 }
  681:             }
  682:         }
  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);
  686:     }
  687:     return (\@groupboards,\%boardshash);
  688: }
  689: 
  690: ###############################################
  691: 
  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);
  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; 
  705:     }
  706:     return;
  707: }
  708: 
  709: ###############################################
  710: 
  711: 1;
  712: 

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