[BACK]Return to longroup.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/longroup.pm between versions 1.2 and 1.32

version 1.2, 2006/05/18 13:49:10 version 1.32, 2023/06/20 14:03:52
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 # accessor routines used to provide information about course groups   # accessor routines used to provide information about course groups 
 #  #
   # $Id$
   #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
Line 23 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
                                                                                   
 package Apache::longroup;  package Apache::longroup;
                                                                                   
 use strict;  use strict;
 use Apache::lonnet;  use Apache::lonnet;
   use Apache::lonlocal;
   use LONCAPA;
   
 ###############################################  ###############################################
 =pod  =pod
Line 40  Input: Line 44  Input:
 1. Optional course domain  1. Optional course domain
 2. Optional course number  2. Optional course number
 3. Optional group name  3. Optional group name
   4. Optional namespace
   
 Course domain and number will be taken from user's  Course domain and number will be taken from user's
 environment if not supplied. Optional group name will   environment if not supplied. Optional group name will 
 be passed to lonnet::get_coursegroups() as a regexp to  be passed to lonnet function as a regexp to
 use in the call to the dump function.  use in the call to the dump function.  Optional namespace
                                                                                   will determine whether information is retrieved about current 
   groups (default) or deleted groups (namespace = deleted_groups). 
   
 Output  Output
 Returns hash of groups in the course (subject to the  Returns hash of groups in a course (subject to the
 optional group name filter). In the hash, the keys are  optional group name filter). In the hash, the keys are
 group names, and their corresponding values  group names, and their corresponding values
 are scalars containing group information in XML. This  are scalars containing group information in XML. This
Line 55  can be sent to &get_group_settings() to Line 62  can be sent to &get_group_settings() to
   
 Side effects:  Side effects:
 None.  None.
   
 =cut  =cut
   
 ###############################################  ###############################################
   
 sub coursegroups {  sub coursegroups {
     my ($cdom,$cnum,$group) = @_;      my ($cdom,$cnum,$group,$namespace) = @_;
     if (!defined($cdom) || !defined($cnum)) {      if (!defined($cdom) || !defined($cnum)) {
         my $cid =  $env{'request.course.id'};          my $cid =  $env{'request.course.id'};
   
Line 69  sub coursegroups { Line 77  sub coursegroups {
         $cdom = $env{'course.'.$cid.'.domain'};          $cdom = $env{'course.'.$cid.'.domain'};
         $cnum = $env{'course.'.$cid.'.num'};          $cnum = $env{'course.'.$cid.'.num'};
     }      }
     my %curr_groups = &Apache::lonnet::get_coursegroups($cdom,$cnum,$group);      if (!defined($namespace)) {
     my ($tmp) = keys(%curr_groups);          $namespace = 'coursegroups';
     if ($tmp=~/^(con_lost|no_such_host|error: [^2] )/) {      } 
         undef(%curr_groups);      my %groups =  &Apache::lonnet::get_coursegroups($cdom,$cnum,$group,
         &logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom);                                                      $namespace);
     } elsif ($tmp=~/^error: 2 /) {      if (my $tmp = &Apache::lonnet::error(%groups)) {
         undef(%curr_groups);   undef(%groups);
           &Apache::lonnet::logthis('Error retrieving groups: '.$tmp.' in '.$cnum.':'.$cdom.' - '.$namespace);
     }      }
     return %curr_groups;      if (defined($groups{'group_allfolders'."\0".'locked_folder'})) {
           delete($groups{'group_allfolders'."\0".'locked_folder'}); 
       }
       return %groups;
 }  }
   
 ###############################################  ###############################################
   
   =pod 
   
 =item get_group_settings  =item get_group_settings
                                                                                   
 Uses TokeParser to extract group information from the  Uses TokeParser to extract group information from the
 XML used to describe course groups.  XML used to describe course groups.
                                                                                   
 Input:  Input:
 Scalar containing XML  - as retrieved from &coursegroups().  Scalar containing XML  - as retrieved from &coursegroups().
                                                                                   
 Output:  Output:
 Hash containing group information as key=values for (a), and  Hash containing group information as key=values for (a), and
 hash of hashes for (b)  hash of hashes for (b)
                                                                                   
 Keys (in two categories):  Keys (in two categories):
 (a) groupname, creator, creation, modified, startdate,enddate.  (a) groupname, creator, creation, modified, startdate, enddate, quota.
 Corresponding values are name of the group, creator of the group  Corresponding values are name of the group, creator of the group
 (username:domain), UNIX time for date group was created, and  (username:domain), UNIX time for date group was created, and
 settings were last modified, and default start and end access  settings were last modified, file quota, and default start and end 
 times for group members.  access times for group members.
                                                                                   
 (b) functions returned in hash of hashes.  (b) functions returned in hash of hashes.
 Outer hash key is functions.  Outer hash key is functions.
 Inner hash keys are chat,discussion,email,files,homepage,roster.  Inner hash keys are chat,discussion,email,files,homepage,roster.
 Corresponding values are either on or off, depending on  Corresponding values are either on or off, depending on
 whether this type of functionality is available for the group.  whether this type of functionality is available for the group.
                                                                                   
 =cut  =cut
   
 ###############################################  ###############################################
Line 155  sub get_group_settings { Line 169  sub get_group_settings {
             } elsif ($token->[1] eq 'role') {              } elsif ($token->[1] eq 'role') {
                 $role = '';                  $role = '';
             }              }
                                                                                   
         }          }
     }      }
     return %content;      return %content;
Line 176  sub check_group_access { Line 189  sub check_group_access {
 ###############################################  ###############################################
   
 =pod  =pod
                                                                                   
 =item group_changes  =item group_changes
   
 Add or drop group memberships in a course as a result of  Add or drop group memberships in a course as a result of
 changes in a user's roles/sections. Called by  changes in a user's roles/sections. Called by
 &Apache::lonnet:assignrole()       &Apache::lonnet:assignrole()     
                                                                                   
 Input:  Input:
 1. User's domain  1. User's domain
 2. User's username  2. User's username
Line 190  Input: Line 203  Input:
 4. Role  4. Role
 5. End date of role  5. End date of role
 6. Start date of role  6. Start date of role
   7. Selfenroll
   8. Context
   
 Checks to see if role for which assignment is being made is in a course.  Checks to see if role for which assignment is being made is in a course.
 If so, gathers information about auto-group population settings for  If so, gathers information about auto-group population settings for
Line 203  for the course is included amongst the u Line 218  for the course is included amongst the u
 and would trigger membership in teh same group(s)   and would trigger membership in teh same group(s) 
   
 If role is being added, will add any group memberships specified  If role is being added, will add any group memberships specified
 for auto-group population, unless use is already a group member.  for auto-group population, unless user is already a group member.
 Uses default group privileges and default start and end group access  Uses default group privileges and default start and end group access
 times.   times.
   
   Flag for selfenroll (value of 1), and context (auto, updatenow, 
   automated, course, domain etc.) can be used to log the reason for
   the role change.     
   
 Output  Output
 None  None
Line 218  or expire group membership(s) for a user Line 237  or expire group membership(s) for a user
 =cut  =cut
   
 sub group_changes {  sub group_changes {
     my ($udom,$uname,$url,$role,$origend,$origstart) = @_;      my ($udom,$uname,$url,$role,$origend,$origstart,$selfenroll,$context,
           $othdomby,$requester) = @_;
     my $now = time;      my $now = time;
     my $chgtype;      my $chgtype;
     if ($origend > 0 && $origend <= $now) {      if ($origend > 0 && $origend <= $now) {
Line 233  sub group_changes { Line 253  sub group_changes {
     } else {      } else {
         $cid = $url;          $cid = $url;
     }      }
     my $courseid = $cid;  
     $courseid =~ s|^/||;  
     $courseid =~ s|/|_|;  
     my %crshash=&Apache::lonnet::coursedescription($cid);      my %crshash=&Apache::lonnet::coursedescription($cid);
     $cdom = $crshash{'domain'};      $cdom = $crshash{'domain'};
     $cnum = $crshash{'num'};      $cnum = $crshash{'num'};
Line 273  sub group_changes { Line 290  sub group_changes {
        if (@changegroups > 0) {         if (@changegroups > 0) {
             my %currpriv;              my %currpriv;
             my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);              my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$cid);
             my ($tmp) = keys(%roleshash);      if (keys(%roleshash) > 0) {
             if ($tmp=~/^error:/) {  
                 &Apache::lonnet::logthis('Error retrieving roles: '.$tmp.  
                                          ' for '.$uname.':'.$udom);  
             } else {  
                 my $group_privs = '';                  my $group_privs = '';
                 foreach my $group (@changegroups) {                  foreach my $group (@changegroups) {
                     if ($chgtype eq 'add') {                      if ($chgtype eq 'add') {
Line 331  sub group_changes { Line 344  sub group_changes {
                                                   $add,$uname.':'.$udom,                                                    $add,$uname.':'.$udom,
                                                   $settings{$add}{'enddate'},                                                    $settings{$add}{'enddate'},
                                                   $settings{$add}{'startdate'},                                                    $settings{$add}{'startdate'},
                                                   $group_privs) eq 'ok') {                                                    $group_privs,$selfenroll,$context,
                                                     $othdomby,$requester) eq 'ok') {
                             my %usersettings;                              my %usersettings;
                             $usersettings{$add.':'.$uname.':'.$udom} =                              $usersettings{$add.':'.$uname.':'.$udom} =
                                                                $addgroup{$add};                                                                 $addgroup{$add};
Line 400  sub group_changes { Line 414  sub group_changes {
                                                          $cnum,$drop,                                                           $cnum,$drop,
                                                          $uname.':'.$udom,$now,                                                           $uname.':'.$udom,$now,
                                                          $dropstart{$drop},                                                           $dropstart{$drop},
                                                          $currpriv{$drop})                                                            $currpriv{$drop},
                                                            $selfenroll,$context,
                                                            $othdomby,$requester) 
                                                                      eq 'ok') {                                                                       eq 'ok') {
                                 my %usersettings;                                  my %usersettings;
                                 $usersettings{$drop.':'.$uname.':'.$udom} =                                  $usersettings{$drop.':'.$uname.':'.$udom} =
Line 420  sub group_changes { Line 436  sub group_changes {
   
 ###############################################  ###############################################
   
   sub get_fixed_privs {
       my $fixedprivs = {
                         email          => {sgm => 1},
                         discussion     => {vgb => 1},
                         chat           => {pgc => 1},
                         files          => {rgf => 1},
                         roster         => {vgm => 1},
                         homepage       => {vgh => 1},
                        };
       return $fixedprivs;
   }
   
   ###############################################
   
   sub get_tool_privs {
       my ($gpterm) = @_;
       my $toolprivs = {
           email    => {
               sgm => 'Send '.$gpterm.' message',
               sgb => 'Broadcast message',
           },
           discussion => {
               cgb => 'Create boards',
               pgd => 'Post',
               egp => 'Edit own posts',
               dgp => 'Hide/Delete any post',
               vgb => 'View boards',
           },
           chat       => {
               pgc => 'Chat Room',
           },
           files      => {
               rgf => 'Retrieve',
               ugf => 'Upload',
               mgf => 'Modify',
               dgf => 'Delete',
               agf => 'Control Access',
           },
           roster     => {
               vgm => 'Basic Display',
               vmd => 'Detailed Display',
           },
           homepage   => {
               vgh => 'View page',
               mgh => 'Modify page',
           },
       };
       return $toolprivs;
   }
   
   ###############################################
   
   
   sub group_memberlist {
       my ($cdom,$cnum,$groupname,$fixedprivs,$available) = @_;
       my %membership = &Apache::lonnet::get_group_membership($cdom,$cnum,
                                                              $groupname);
       my %current = ();
       my $hastools = 0;
       my $addtools = 0;
       my %member_nums = (
                           'previous' => 0,
                           'future' => 0,
                           'active' => 0,
                         );
       my $now = time;
       if (keys(%membership) > 0) {
           my %allnames = ();
           foreach my $key (sort(keys(%membership))) {
               if ($key =~ /^\Q$groupname\E:([^:]+):([^:]+)$/) {
                   my $uname = $1;
                   my $udom = $2;
                   my $user = $uname.':'.$udom;
                   my($end,$start,@userprivs) = split(/:/,$membership{$key});
                   unless ($start == -1) {
                       $allnames{$udom}{$uname} = 1;
                       $current{$user} = {
                           uname     => $uname,
                           udom      => $udom,
                           start     => &Apache::lonlocal::locallocaltime($start),
                           currtools => [],
                           newtools  => [],
                           privs     => \@userprivs,
                       };
   
                       if ($end == 0) {
                           $current{$user}{end} =  'No end date';
                       } else {
                           $current{$user}{end} =
                                        &Apache::lonlocal::locallocaltime($end);
                       }
                       my $now = time;
                       if (($end > 0) && ($end < $now)) {
                           $current{$user}{changestate} = 'reenable';
                           $current{$user}{'status'} = 'previous';
                           $member_nums{'previous'} ++;
                       } elsif (($start > $now)) {
                           $current{$user}{changestate} = 'activate';
                           $current{$user}{'status'} = 'future';
                           $member_nums{'future'} ++;
                       } else {
                           $current{$user}{changestate} = 'expire';
                           $current{$user}{'status'} = 'active';
                           $member_nums{'active'} ++;
                       }
                       if ((@userprivs > 0) && (ref($fixedprivs) eq 'HASH')) {
                           foreach my $tool (sort(keys(%{$fixedprivs}))) {
                               foreach my $priv (keys(%{$$fixedprivs{$tool}})) {
                                   if (grep/^$priv$/,@userprivs) {
                                       push(@{$current{$user}{currtools}},$tool);
                                       last;
                                   }
                               }
                           }
                           $hastools = 1;
                       }
                       if ((ref($available) eq 'ARRAY') && (@{$available} > 0)) {
                           if (@{$current{$user}{currtools}} > 0) {
                               if ("@{$available}" ne "@{$current{$user}{currtools}}") {
                                   foreach my $tool (@{$available}) {
                                       unless (grep/^$tool$/,@{$current{$user}{currtools}}) {
                                           push(@{$current{$user}{newtools}},$tool);                                    }
                                   }
                               }
                           } else {
                               @{$current{$user}{newtools}} = @{$available};
   
                           }
                           if (@{$current{$user}{newtools}} > 0) {
                               $addtools = 1;
                           }
                       }
                   }
               }
           }
           if (keys(%current) > 0) {
               my %idhash;
               foreach my $udom (keys(%allnames)) {
                   %{$idhash{$udom}} = &Apache::lonnet::idrget($udom,
                                                   keys(%{$allnames{$udom}}));
                   foreach my $uname (keys(%{$idhash{$udom}})) {
                       $current{$uname.':'.$udom}{'id'} = $idhash{$udom}{$uname};
                   }
                   foreach my $uname (keys(%{$allnames{$udom}})) {
                       $current{$uname.':'.$udom}{'fullname'} =
                                   &Apache::loncommon::plainname($uname,$udom,
                                                                     'lastname');
                   }
               }
           }
       }
       return (\%current,\%member_nums,$hastools,$addtools);
   }
   
   ###############################################
   
   sub sum_quotas {
       my ($courseid) = @_;
       my $totalquotas = 0;
       my ($cdom,$cnum);
       if (!defined($courseid)) {
           if (defined($env{'request.course.id'})) {
               $courseid = $env{'request.course.id'};
               $cdom = $env{'course.'.$courseid.'.domain'};
               $cnum = $env{'course.'.$courseid.'.num'};
           } else {
               return '';
           }
       } else {
           ($cdom,$cnum) = split(/_/,$courseid);
       }
       if ($cdom && $cnum) {
           my %curr_groups = &coursegroups($cdom,$cnum);
           if (%curr_groups) {
               foreach my $group (keys(%curr_groups)) {
                   my %settings=&get_group_settings($curr_groups{$group});
                   my $quota = $settings{'quota'};
                   if ($quota eq '') {
                       $quota = 0;
                   }
                   $totalquotas += $quota; 
               }
           } else {
               return 0;
           }
       } else {
           return '';
       }
       return $totalquotas;
   }
   
   ###############################################
   
   sub get_bbfolder_url {
       my ($cdom,$cnum,$group) = @_;
       my %curr_groups = &coursegroups($cdom,$cnum,$group);
       my $grpbbmap;
       if (%curr_groups) {
           my $crspath = '/uploaded/'.$cdom.'/'.$cnum.'/';
           $grpbbmap = $crspath.'group_boards_'.$group.'.sequence';
       }
       return $grpbbmap;
   }
   
   ###############################################
   
   sub get_group_bbinfo {
       my ($cdom,$cnum,$group,$boardurl) = @_;
       my @groupboards = ();
       my %boardshash = ();
       my $navmap = Apache::lonnavmaps::navmap->new();
       if (defined($navmap)) {
           my $grpbbmap = &get_bbfolder_url($cdom,$cnum,$group);
           if ($grpbbmap) {
               my $bbfolderres = $navmap->getResourceByUrl($grpbbmap);
               if ($bbfolderres) {
                   my @boards = $navmap->retrieveResources($bbfolderres,undef,0,0);
                   foreach my $res (@boards) {
                       my $url = $res->src();
                       if ($url =~ m|^(/adm/\Q$cdom\E/\Q$cnum\E/\d+/bulletinboard)|) {
                           if ($boardurl) {
                               if ($boardurl =~ /^\Q$1\E/) {
                                   push(@groupboards,$res->symb());
                                   $boardshash{$res->symb()} = {
                                                           title => $res->title(),
                                                           url   => $res->src(),
                                                               };
                                   last;
                               }
                           } else {
                               push(@groupboards,$res->symb());
                               $boardshash{$res->symb()} = {
                                                         title => $res->title(),
                                                         url   => $res->src(),
                                                           };
                           }
                       }
                   }
               }
           }
           undef($navmap);
       } else {
           &Apache::lonnet::logthis('Retrieval of group boards failed - could not create navmap object for group: '.$group.' in course: '.$cdom.':'.$cnum);
       }
       return (\@groupboards,\%boardshash);
   }
   
   ###############################################
   
   sub get_group_link {
       my ($cdom,$cnum,$group,$navmap,$view_permission,$refarg) = @_;
       if (ref($navmap)) {
           my $map = "uploaded/$cdom/$cnum/group_folder_"."$group.sequence";
           my $mapres = $navmap->getResourceByUrl("/$map");
           my $hidden;
           if (ref($mapres)) {
               if ((!$view_permission) && ($mapres->randomout())) {
                   $hidden = 1;
               }
           }
           my $url = "adm/$cdom/$cnum/$group/smppg";
           my $idx = '1';
           my $symb = $map.'___'.$idx.'___'.$url;
           my $res = $navmap->getBySymb($symb);
           $url = "/$url";
           $map = "/$map";
           my $link;
           if (ref($res)) {
               if ((!$view_permission) && ($res->randomout())) {
                   $hidden = 1;
               } else {
                   $hidden = 0;
                   if ($refarg) {
                       $link = $url.'?'.$refarg;
                   } else {
                       $link = $res->link();
                       $link .= (($link=~/\?/)?'&amp;':'?').'symb='.$res->shown_symb();
                   }
               }
           } elsif (&Apache::lonnet::is_on_map($url)) {
               unless ($hidden) {
                   $link = $url;
                   if ($refarg) {
                       $link = $url.'?'.$refarg;
                   }
               }
           }
           if (wantarray) {
               return ($link,$hidden);
           } else {
               return $link;
           }
       }
       return;
   }
   
   ###############################################
   
   sub display_group_links {
       my ($r,$target,$group,$context,$refarg,$numtoolsref,$hidehdr,%groupinfo) = @_;
       my @available = ();
       my %menu = ();
       %{$menu{'email'}} = (
                           text => 'Group Message',
                           href => '/adm/email?compose=group&amp;group='.$group.
                                   $refarg,
                         );
       %{$menu{'discussion'}} = (
                           text => 'Discussion Boards',
                           href => '/adm/groupboards?group='.$group.$refarg,
                         );
       %{$menu{'chat'}} = (
                           text => 'Group Chat Room',
                           href => "javascript:group_chat('$group')",
                         );
       %{$menu{'files'}} = (
                           text => 'Group Portfolio',
                           href => '/adm/coursegrp_portfolio?group='.$group.
                                   $refarg,
                         );
       %{$menu{'roster'}} = (
                           text => 'Membership Roster',
                           href => '/adm/grouproster?group='.$group.$refarg,
                         );
       foreach my $tool (sort(keys(%menu))) {
           if ($groupinfo{functions}{$tool} eq 'on') {
               push(@available,$tool);
           }
       }
       my $output = '';
       if (ref($numtoolsref) eq 'SCALAR') {
           $$numtoolsref = scalar(@available);
       }
       if (@available > 0) {
           if ($target eq 'tex') {
               $output = '<table cellspacing="4" cellpadding="4">';
           } else {
               $output = &Apache::loncommon::start_data_table();
           }
           foreach my $tool (@available) {
               if ($target eq 'tex') {
                   $output .= '<tr><td>'.&mt($menu{$tool}{text}).'</td></tr>';
               } else {
                   $output .= &Apache::loncommon::start_data_table_row()
                             .'<td><a href="'.$menu{$tool}{href}.'">'
                             .&mt($menu{$tool}{text}).'</a></td>'
                             .&Apache::loncommon::end_data_table_row();
               }
           }
           if ($target eq 'tex') {
               $output .= '</table>';
           } else {
               $output .= &Apache::loncommon::end_data_table();
           }
           if ($target eq 'tex') {
               $output = &Apache::lonxml::xmlparse($r,'tex',&mt('Available functions').'<br /><br />'.$output);
           } else {
               unless ($hidehdr) {
                   $output = '<h3>'.&mt('Available Group Tools').'</h3>'.$output;
               }
           }
       } else {
           if ($context eq 'edit') {
               $output = &mt('No group functionality.');
           } else {
               $output = &mt('No group functionality (e.g., e-mail, discussion, chat room or file upload) is currently available to you in this group: [_1].',
                         '<b>'.&unescape($groupinfo{'description'}).'</b>');
           }
           if ($target eq 'tex') {
               $output = &Apache::lonxml::xmlparse($r,'tex',$output);
           }
       }
       return $output;
   }
   
 1;  1;
   
Removed from v.1.2  
changed lines
  Added in v.1.32

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