Return to longroup.pm CVS log

Up to [LON-CAPA] / loncom / interface

- fix pod documentation

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