Return to longroup.pm CVS log

Up to [LON-CAPA] / loncom / interface

File sizes for uploads to course group portfolios may not exceed quota set for group's file repository. When creating a course, a quota can be specified.  The sum of quotas assigned to all groups in a course can not exceed the total quota defined for the course (when the course was created).  - client side and server side enforcement still needed here.  Portfolio permissions modified to allow any user with group creation rights in a course access to all course group portfolio functions.  All uses of words: group, Group, course and Course in "Course Groups Manager" now replaced with context-sensitive terminology provided by loncommon::course_type() and loncommon::group_term() which will supply appropriate text once a decision is made on Group vs Group. Currently "ANGEL-like Discussion Groups" are called Groups, regular courses are called Courses; and within regular courses sectionesque units are called groups, and within Groups they are called teams.

    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: 
   44: Course domain and number will be taken from user's
   45: environment if not supplied. Optional group name will 
   46: be passed to lonnet::get_coursegroups() as a regexp to
   47: use in the call to the dump function.
   48: 
   49: Output
   50: Returns hash of groups in the course (subject to the
   51: optional group name filter). In the hash, the keys are
   52: group names, and their corresponding values
   53: are scalars containing group information in XML. This
   54: can be sent to &get_group_settings() to be parsed.
   55: 
   56: Side effects:
   57: None.
   58: =cut
   59: 
   60: ###############################################
   61: 
   62: sub coursegroups {
   63:     my ($cdom,$cnum,$group) = @_;
   64:     if (!defined($cdom) || !defined($cnum)) {
   65:         my $cid =  $env{'request.course.id'};
   66: 
   67:         return if (!defined($cid));
   68: 
   69:         $cdom = $env{'course.'.$cid.'.domain'};
   70:         $cnum = $env{'course.'.$cid.'.num'};
   71:     }
   72:     my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);
   73:     if (my $tmp = &Apache::lonnet::error(%curr_groups)) {
   74: 	undef(%curr_groups);
   75:         &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);
   76:     }
   77:     return %curr_groups;
   78: }
   79: 
   80: ###############################################
   81: 
   82: =item get_group_settings
   83: 
   84: Uses TokeParser to extract group information from the
   85: XML used to describe course groups.
   86: 
   87: Input:
   88: Scalar containing XML  - as retrieved from &coursegroups().
   89: 
   90: Output:
   91: Hash containing group information as key=values for (a), and
   92: hash of hashes for (b)
   93: 
   94: Keys (in two categories):
   95: (a) groupname, creator, creation, modified, startdate, enddate, quota.
   96: Corresponding values are name of the group, creator of the group
   97: (username:domain), UNIX time for date group was created, and
   98: settings were last modified, file quota, and default start and end 
   99: access times for group members.
  100: 
  101: (b) functions returned in hash of hashes.
  102: Outer hash key is functions.
  103: Inner hash keys are chat,discussion,email,files,homepage,roster.
  104: Corresponding values are either on or off, depending on
  105: whether this type of functionality is available for the group.
  106: 
  107: =cut
  108: 
  109: ###############################################
  110: 
  111: sub get_group_settings {
  112:     my ($groupinfo)=@_;
  113:     my $parser=HTML::TokeParser->new(\$groupinfo);
  114:     my $token;
  115:     my $tool = '';
  116:     my $role = '';
  117:     my %content=();
  118:     while ($token=$parser->get_token) {
  119:         if ($token->[0] eq 'S')  {
  120:             my $entry=$token->[1];
  121:             if ($entry eq 'functions' || $entry eq 'autosec') {
  122:                 %{$content{$entry}} = ();
  123:                 $tool = $entry;
  124:             } elsif ($entry eq 'role') {
  125:                 if ($tool eq 'autosec') {
  126:                     $role = $token->[2]{id};
  127:                     @{$content{$tool}{$role}} = ();
  128:                 }
  129:             } else {
  130:                 my $value=$parser->get_text('/'.$entry);
  131:                 if ($entry eq 'name') {
  132:                     if ($tool eq 'functions') {
  133:                         my $function = $token->[2]{id};
  134:                         $content{$tool}{$function} = $value;
  135:                     }
  136:                 } elsif ($entry eq 'groupname') {
  137:                     $content{$entry}=&unescape($value);
  138:                 } elsif (($entry eq 'roles') || ($entry eq 'types') ||
  139:                          ($entry eq 'sectionpick') || ($entry eq 'defpriv')) {
  140:                     push(@{$content{$entry}},$value);
  141:                 } elsif ($entry eq 'section') {
  142:                     if ($tool eq 'autosec'  && $role ne '') {
  143:                         push(@{$content{$tool}{$role}},$value);
  144:                     }
  145:                 } else {
  146:                     $content{$entry}=$value;
  147:                 }
  148:             }
  149:         } elsif ($token->[0] eq 'E') {
  150:             if ($token->[1] eq 'functions' || $token->[1] eq 'autosec') {
  151:                 $tool = '';
  152:             } elsif ($token->[1] eq 'role') {
  153:                 $role = '';
  154:             }
  155:         }
  156:     }
  157:     return %content;
  158: }
  159: 
  160: ###############################################
  161: 
  162: sub check_group_access {
  163:     my ($group) = @_;
  164:     my $access = 1;
  165:     my $now = time;
  166:     my ($start,$end) = split(/\./,$env{'user.role.gr/'.$env{'request.course,id'}.'/'.$group});
  167:     if (($end!=0) && ($end<$now)) { $access = 0; }
  168:     if (($start!=0) && ($start>$now)) { $access=0; }
  169:     return $access;
  170: }
  171: 
  172: ###############################################
  173: 
  174: =pod
  175: 
  176: =item group_changes
  177: 
  178: Add or drop group memberships in a course as a result of
  179: changes in a user's roles/sections. Called by
  180: &Apache::lonnet:assignrole()     
  181: 
  182: Input:
  183: 1. User's domain
  184: 2. User's username
  185: 3. Url of role
  186: 4. Role
  187: 5. End date of role
  188: 6. Start date of role
  189: 
  190: Checks to see if role for which assignment is being made is in a course.
  191: If so, gathers information about auto-group population settings for
  192: groups in the course.
  193: 
  194: If role is being expired, will also expire any group memberships that
  195: are specified for auto-group population for the specific role and
  196: section (including section 'none' and 'all' sections), unless a
  197: different role/section also included in auto-group population
  198: for the course is included amongst the user's unexpired roles
  199: and would trigger membership in teh same group(s) 
  200: 
  201: If role is being added, will add any group memberships specified
  202: for auto-group population, unless use is already a group member.
  203: Uses default group privileges and default start and end group access
  204: times. 
  205: 
  206: Output
  207: None
  208: 
  209: Side effects:
  210: May result in calls to Apache::lonnet::modify_group_roles()
  211: and Apache::lonnet::modify_coursegroup_membership() to add
  212: or expire group membership(s) for a user. 
  213: 
  214: =cut
  215: 
  216: sub group_changes {
  217:     my ($udom,$uname,$url,$role,$origend,$origstart) = @_;
  218:     my $now = time;
  219:     my $chgtype;
  220:     if ($origend > 0 && $origend <= $now) {
  221:         $chgtype = 'drop';
  222:     } else {
  223:         $chgtype = 'add';
  224:     }
  225:     my ($cid,$cdom,$cnum,$sec);
  226:     if ($url =~ m-^(/[^/]+/[^/]+)/([^/]+)$-) {
  227:         $cid = $1;
  228:         $sec = $2;
  229:     } else {
  230:         $cid = $url;
  231:     }
  232:     my $courseid = $cid;
  233:     $courseid =~ s|^/||;
  234:     $courseid =~ s|/|_|;
  235:     my %crshash=&Apache::lonnet::coursedescription($cid);
  236:     $cdom = $crshash{'domain'};
  237:     $cnum = $crshash{'num'};
  238:     if (defined($cdom) && defined($cnum)) {
  239:         my %settings;
  240:         my @changegroups = ();
  241:         my %dropgroup = ();
  242:         my %dropstart = ();
  243:         my %addgroup = ();
  244:         my %curr_groups = &coursegroups($cdom,$cnum);
  245:         if (%curr_groups) {
  246:             foreach my $group (keys(%curr_groups)) {
  247:                 %{$settings{$group}}=&get_group_settings($curr_groups{$group});
  248:                 if ($chgtype eq 'add') {
  249:                     if (!($settings{$group}{autoadd} eq 'on')) {
  250:                         next;
  251:                     }
  252:                 } else {
  253:                     if (!($settings{$group}{autodrop} eq 'on')) {
  254:                         next;
  255:                     }
  256:                 }
  257:                 my @autosec = ();
  258:                 if (ref($settings{$group}{'autosec'}{$role}) eq 'ARRAY') {
  259:                     @autosec = @{$settings{$group}{'autosec'}{$role}};
  260:                 }
  261:                 if ($sec eq '') {
  262:                     $sec = 'none';
  263:                 }
  264:                 if ((grep(/^$sec$/,@autosec)) || (grep(/^all$/,@autosec))) {
  265:                     push(@changegroups,$group);
  266:                 }
  267:             }
  268:         }
  269:        if (@changegroups > 0) {
  270:             my %currpriv;
  271:             my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
  272: 	    if (my $tmp = &Apache::lonnet::error(%roleshash)) {
  273:                 &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.
  274:                                          ' for '.$uname.':'.$udom);
  275:             } else {
  276:                 my $group_privs = '';
  277:                 foreach my $group (@changegroups) {
  278:                     if ($chgtype eq 'add') {
  279:                         if (ref($settings{$group}{'defpriv'}) eq 'ARRAY') {
  280:                             $group_privs =
  281:                                   join(':',@{$settings{$group}{'defpriv'}});
  282:                         }
  283:                     }
  284:                     my $key = $cid.'/'.$group.'_gr';
  285:                     if (defined($roleshash{$key})) {
  286:                         if ($roleshash{$key}=~ /^gr\/([^_]*)_(\d+)_([\-\d]+)$/) {
  287:                             my $grpstart = $3;
  288:                             my $grpend = $2;
  289:                             $currpriv{$group} = $1;
  290:                             if ($chgtype eq 'drop') {
  291:                                 if ($grpstart == -1) { next; } # deleted
  292:                                 if ($grpend == 0 || $grpend > $now) {
  293:                                     if (!defined($dropgroup{$group})) {
  294:                                         $dropstart{$group} = $grpstart;
  295:                                         if ($grpstart > $now) {
  296:                                             $dropstart{$group} = $now;
  297:                                         }
  298:                                         $dropgroup{$group} = $now.':'.
  299:                                                             $dropstart{$group}.
  300:                                                          ':'.$currpriv{$group};
  301:                                     }
  302:                                 }
  303:                             } elsif ($chgtype eq 'add') {
  304:                                 if (($grpstart == -1) || ($grpend > 0 &&
  305:                                      ($grpend < $settings{$group}{'enddate'} ||
  306:                                       $settings{$group}{'enddate'} == 0)) ||
  307:                                      ($grpstart > $settings{$group}{'startdate'})) {
  308:                                     if (!defined($addgroup{$group})) {
  309:                                         $addgroup{$group} =
  310:                                             $settings{$group}{'enddate'}.':'.
  311:                                             $settings{$group}{'startdate'}.':'.
  312:                                             $group_privs;
  313:                                     }
  314:                                 }
  315:                             }
  316:                         }
  317:                     } elsif ($chgtype eq 'add') {
  318:                         $addgroup{$group} = $settings{$group}{'enddate'}.':'.
  319:                                             $settings{$group}{'startdate'}.':'.
  320:                                             $group_privs;
  321:                     }
  322:                 }
  323:                 if ($chgtype eq 'add') {
  324:                     foreach my $add (keys(%addgroup)) {
  325:                         if (&Apache::lonnet::modify_group_roles($cdom,$cnum,
  326:                                                   $add,$uname.':'.$udom,
  327:                                                   $settings{$add}{'enddate'},
  328:                                                   $settings{$add}{'startdate'},
  329:                                                   $group_privs) eq 'ok') {
  330:                             my %usersettings;
  331:                             $usersettings{$add.':'.$uname.':'.$udom} =
  332:                                                                $addgroup{$add};
  333:                             my $roster_result =
  334:                                &Apache::lonnet::modify_coursegroup_membership(
  335:                                                    $cdom,$cnum,\%usersettings);
  336:                         }
  337:                     }
  338:                 } elsif ($chgtype eq 'drop') {
  339:                     foreach my $drop (keys(%dropgroup)) {
  340:                         my $nodrop = 0;
  341:                         if ($settings{$drop}{'autoadd'} eq 'on') {
  342:                             foreach my $urole (keys(%{$settings{$drop}{'autosec'}})) {
  343:                                 if ($nodrop) {
  344:                                     last;
  345:                                 } else {
  346:                                     my @autosec = ();
  347:                                     if (ref($settings{$drop}{'autosec'}{$urole}) eq 'ARRAY') {
  348:                                         @autosec = @{$settings{$drop}{'autosec'}{$urole}};
  349:                                     }
  350:                                     foreach my $usec (@autosec) {
  351:                                         if ($usec eq 'all') {
  352:                                             foreach my $ukey (keys(%roleshash)) {
  353:                                                 if ($ukey =~ /^\Q$cid\E(\/?\w*)_($urole)$/) {
  354:                                                     if ($sec ne $1) {
  355:                                                         if ($roleshash{$ukey} =~ /_?(\d*)_?([\-\d]*)$/) {
  356:                                                             my $roleend = $1;
  357:                                                             if ((!$roleend) ||
  358:                                                                 ($roleend > $now)) {
  359:                                                                 $nodrop = 1;
  360:                                                                 last;
  361:                                                             }
  362:                                                         }
  363:                                                     }
  364:                                                 }
  365:                                             }
  366:                                         } else {
  367:                                             my $ukey = $cid.'/'.$usec.'_'.$urole;
  368:                                             if ($usec eq 'none') {
  369:                                                 if ($sec eq '') {
  370:                                                     next;
  371:                                                 }
  372:                                             } else {
  373:                                                 if ($usec eq $sec) {
  374:                                                     next;
  375:                                                 }
  376:                                             }
  377:                                             if (exists($roleshash{$ukey})) {
  378:                                                 if ($roleshash{$ukey} =~
  379:                                                        /_?(\d*)_?([\-\d]*)$/) {
  380:                                                     my $roleend = $1;
  381:                                                     if ((!$roleend) ||
  382:                                                         ($roleend > $now)) {
  383:                                                         $nodrop = 1;
  384:                                                         last;
  385:                                                     }
  386:                                                 }
  387:                                             }
  388:                                         }
  389:                                     }
  390:                                 }
  391:                             }
  392:                         }
  393:                         if (!$nodrop) {
  394:                             if (&Apache::lonnet::modify_group_roles($cdom,
  395:                                                          $cnum,$drop,
  396:                                                          $uname.':'.$udom,$now,
  397:                                                          $dropstart{$drop},
  398:                                                          $currpriv{$drop}) 
  399:                                                                      eq 'ok') {
  400:                                 my %usersettings;
  401:                                 $usersettings{$drop.':'.$uname.':'.$udom} =
  402:                                                              $dropgroup{$drop};
  403:                                 my $roster_result =
  404:                                 &Apache::lonnet::modify_coursegroup_membership(
  405:                                                    $cdom,$cnum,\%usersettings);
  406:                             }
  407:                         }
  408:                     }
  409:                 }
  410:             }
  411:         }
  412:     }
  413:     return;
  414: }
  415: 
  416: ###############################################
  417: 
  418: sub sum_quotas {
  419:     my ($courseid) = @_;
  420:     my $totalquotas = 0;
  421:     my ($cdom,$cnum);
  422:     if (!defined($courseid)) {
  423:         if (defined($env{'request.course.id'})) {
  424:             $courseid = $env{'request.course.id'};
  425:             $cdom = $env{'course.'.$courseid.'.domain'};
  426:             $cnum = $env{'course.'.$courseid.'.num'};
  427:         } else {
  428:             return '';
  429:         }
  430:     } else {
  431:         ($cdom,$cnum) = split(/_/,$courseid);
  432:     }
  433:     if ($cdom && $cnum) {
  434:         my %curr_groups = &coursegroups($cdom,$cnum);
  435:         if (%curr_groups) {
  436:             foreach my $group (keys(%curr_groups)) {
  437:                 my %settings=&get_group_settings($curr_groups{$group});
  438:                 my $quota = $settings{'quota'};
  439:                 if ($quota eq '') {
  440:                     $quota = 0;
  441:                 }
  442:                 $totalquotas += $quota; 
  443:             }
  444:         } else {
  445:             return 0;
  446:         }
  447:     } else {
  448:         return '';
  449:     }
  450:     return $totalquotas;
  451: }
  452: 
  453: ###############################################
  454: 
  455: 1;
  456: